From 70639dfa275a4c24169b83cc9db31d73a175bddd Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Fri, 19 May 2023 18:14:07 -0600 Subject: [PATCH 01/12] Adding a new SeaSt_WaveField module for future use --- modules/openfast-library/src/FAST_Types.f90 | 2 +- modules/openfoam/src/OpenFOAM_Types.f90 | 10 +- modules/seastate/CMakeLists.txt | 3 + modules/seastate/src/SeaSt_WaveField.f90 | 311 ++++ modules/seastate/src/SeaSt_WaveField.txt | 21 + .../seastate/src/SeaSt_WaveField_Types.f90 | 1266 +++++++++++++++++ modules/seastate/src/SeaState.f90 | 174 +-- modules/seastate/src/SeaState.txt | 2 + modules/seastate/src/SeaState_Types.f90 | 93 +- 9 files changed, 1738 insertions(+), 144 deletions(-) create mode 100644 modules/seastate/src/SeaSt_WaveField.f90 create mode 100644 modules/seastate/src/SeaSt_WaveField.txt create mode 100644 modules/seastate/src/SeaSt_WaveField_Types.f90 diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 7a2b73f8f1..63893b4018 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -775,7 +775,7 @@ MODULE FAST_Types CHARACTER(1024) :: RootName !< Root name of FAST output files (overrides normal operation) [-] INTEGER(IntKi) :: NumActForcePtsBlade !< number of actuator line force points in blade [-] INTEGER(IntKi) :: NumActForcePtsTower !< number of actuator line force points in tower [-] - INTEGER(IntKi) :: NodeClusterType !< Node clustering for actuator line (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] + LOGICAL :: NodeClusterType !< Node clustering for actuator line (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] END TYPE FAST_ExternInitType ! ======================= ! ========= FAST_TurbineType ======= diff --git a/modules/openfoam/src/OpenFOAM_Types.f90 b/modules/openfoam/src/OpenFOAM_Types.f90 index a3a92c86e5..3613f4b483 100644 --- a/modules/openfoam/src/OpenFOAM_Types.f90 +++ b/modules/openfoam/src/OpenFOAM_Types.f90 @@ -104,7 +104,7 @@ MODULE OpenFOAM_Types REAL(KIND=C_FLOAT) :: BladeLength REAL(KIND=C_FLOAT) :: TowerHeight REAL(KIND=C_FLOAT) :: TowerBaseHeight - LOGICAL(KIND=C_BOOL) :: NodeClusterType + INTEGER(KIND=C_INT) :: NodeClusterType END TYPE OpFM_ParameterType_C TYPE, PUBLIC :: OpFM_ParameterType TYPE( OpFM_ParameterType_C ) :: C_obj @@ -419,7 +419,7 @@ SUBROUTINE OpFM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%TowerBaseHeight Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%NodeClusterType, IntKiBuf(1)) + IntKiBuf(Int_Xferred) = InData%NodeClusterType Int_Xferred = Int_Xferred + 1 END SUBROUTINE OpFM_PackInitInput @@ -507,7 +507,7 @@ SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight - OutData%NodeClusterType = TRANSFER(IntKiBuf(Int_Xferred), OutData%NodeClusterType) + OutData%NodeClusterType = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%C_obj%NodeClusterType = OutData%NodeClusterType END SUBROUTINE OpFM_UnPackInitInput @@ -1957,7 +1957,7 @@ SUBROUTINE OpFM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%TowerBaseHeight Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%NodeClusterType, IntKiBuf(1)) + IntKiBuf(Int_Xferred) = InData%NodeClusterType Int_Xferred = Int_Xferred + 1 END SUBROUTINE OpFM_PackParam @@ -2060,7 +2060,7 @@ SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight - OutData%NodeClusterType = TRANSFER(IntKiBuf(Int_Xferred), OutData%NodeClusterType) + OutData%NodeClusterType = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%C_obj%NodeClusterType = OutData%NodeClusterType END SUBROUTINE OpFM_UnPackParam diff --git a/modules/seastate/CMakeLists.txt b/modules/seastate/CMakeLists.txt index c7f418fa34..a9d852866d 100644 --- a/modules/seastate/CMakeLists.txt +++ b/modules/seastate/CMakeLists.txt @@ -19,6 +19,7 @@ if (GENERATE_TYPES) 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,6 +29,7 @@ add_library(seastlib src/Waves2.f90 src/UserWaves.f90 src/SeaState_Interp.f90 + src/SeaSt_WaveField.f90 src/SeaState_Input.f90 src/SeaState.f90 src/SeaState_Output.f90 @@ -35,6 +37,7 @@ add_library(seastlib src/Waves_Types.f90 src/Waves2_Types.f90 src/SeaState_Interp_Types.f90 + src/SeaSt_WaveField_Types.f90 src/SeaState_Types.f90 ) target_link_libraries(seastlib nwtclibs versioninfolib) diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 new file mode 100644 index 0000000000..f2d96b204f --- /dev/null +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -0,0 +1,311 @@ +MODULE SeaSt_WaveField + +USE SeaState_Interp +USE SeaSt_WaveField_Types + +IMPLICIT NONE + +PRIVATE + +! Public functions and subroutines +PUBLIC WaveField_GetWaveElev1 +PUBLIC WaveField_GetWaveElev2 +PUBLIC WaveField_GetTotalWaveElev +PUBLIC WaveField_GetWaveNormal +PUBLIC WaveField_GetWaveKin +PUBLIC WaveField_End + +CONTAINS + +!-------------------- Subroutine for wave elevation ------------------! +FUNCTION WaveField_GetWaveElev1( WaveField, Time, pos, ErrStat, ErrMsg ) + TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + 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_GetWaveElev1 + REAL(SiKi) :: Zeta + LOGICAL :: FirstWarn_Clamp + CHARACTER(*), PARAMETER :: RoutineName = 'GetWaveElev1' + INTEGER(IntKi) :: errStat2 + CHARACTER(ErrMsgLen) :: errMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + IF (associated(WaveField%WaveElev1)) THEN + Zeta = SeaSt_Interp_3D( Time, pos(1:2), WaveField%WaveElev1, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSE + Zeta = 0.0_SiKi + END IF + + WaveField_GetWaveElev1 = Zeta + +END FUNCTION WaveField_GetWaveElev1 + +FUNCTION WaveField_GetWaveElev2( WaveField, Time, pos, ErrStat, ErrMsg ) + TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + 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_GetWaveElev2 + REAL(SiKi) :: Zeta + LOGICAL :: FirstWarn_Clamp + CHARACTER(*), PARAMETER :: RoutineName = 'GetWaveElev2' + INTEGER(IntKi) :: errStat2 + CHARACTER(ErrMsgLen) :: errMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + IF (associated(WaveField%WaveElev2)) THEN + Zeta = SeaSt_Interp_3D( Time, pos(1:2), WaveField%WaveElev2, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSE + Zeta = 0.0_SiKi + END IF + + WaveField_GetWaveElev2 = Zeta + +END FUNCTION WaveField_GetWaveElev2 + +FUNCTION WaveField_GetTotalWaveElev( WaveField, Time, pos, ErrStat, ErrMsg ) + TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + 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_GetTotalWaveElev + REAL(SiKi) :: Zeta1, Zeta2 + LOGICAL :: FirstWarn_Clamp + CHARACTER(*), PARAMETER :: RoutineName = 'GetTotalWaveElev' + INTEGER(IntKi) :: errStat2 + CHARACTER(ErrMsgLen) :: errMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + Zeta1 = WaveField_GetWaveElev1( WaveField, Time, pos, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Zeta2 = WaveField_GetWaveElev2( WaveField, Time, pos, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + WaveField_GetTotalWaveElev = Zeta1 + Zeta2 + +END FUNCTION WaveField_GetTotalWaveElev + +SUBROUTINE WaveField_GetWaveNormal( WaveField, Time, pos, r, n, ErrStat, ErrMsg ) + + TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + 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(ReKi) :: r1,ZetaP,ZetaM,dZetadx,dZetady + CHARACTER(*), PARAMETER :: RoutineName = 'GetFreeSurfaceNormal' + INTEGER(IntKi) :: errStat2 + CHARACTER(ErrMsgLen) :: errMsg2 + ErrStat = ErrID_None + ErrMsg = "" + + r1 = MAX(r,1.0e-6) ! In case r is zero + + ZetaP = WaveField_GetTotalWaveElev( WaveField, Time, (/pos(1)+r1,pos(2)/), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ZetaM = WaveField_GetTotalWaveElev( WaveField, Time, (/pos(1)-r1,pos(2)/), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + dZetadx = (ZetaP-ZetaM)/(2.0_ReKi*r1) + + ZetaP = WaveField_GetTotalWaveElev( WaveField, Time, (/pos(1),pos(2)+r1/), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ZetaM = WaveField_GetTotalWaveElev( WaveField, Time, (/pos(1),pos(2)-r1/), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + dZetady = (ZetaP-ZetaM)/(2.0_ReKi*r1) + + n = (/-dZetadx,-dZetady,1.0_ReKi/) + n = n / SQRT(Dot_Product(n,n)) + +END SUBROUTINE WaveField_GetWaveNormal + +!-------------------- Subroutine for full wave field kinematics --------------------! +SUBROUTINE WaveField_GetWaveKin( WaveField, Time, pos, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) + TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + REAL(DbKi), INTENT( IN ) :: Time + REAL(ReKi), INTENT( IN ) :: pos(3) + 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) + TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m + LOGICAL :: FirstWarn_Clamp + CHARACTER(*), PARAMETER :: RoutineName = 'GetWaveKin' + INTEGER(IntKi) :: errStat2 + CHARACTER(ErrMsgLen) :: errMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + posXY = pos(1:2) + posXY0 = (/pos(1),pos(2),0.0_ReKi/) + FAMCF(:) = 0.0 + + ! Wave elevation + WaveElev1 = WaveField_GetWaveElev1( WaveField, Time, pos, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + WaveElev2 = WaveField_GetWaveElev2( WaveField, Time, pos, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + 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 ) + IF ( ASSOCIATED(WaveField%WaveAccMCF) ) THEN + FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, seast_interp_m, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + ELSE ! Node is above the SWL + nodeInWater = 0_IntKi + FV(:) = 0.0 + FA(:) = 0.0 + FDynP = 0.0 + FAMCF(:) = 0.0 + END IF + + ELSE ! Wave stretching enabled + + IF ( pos(3) <= WaveElev ) 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 ) + IF ( ASSOCIATED(WaveField%WaveAccMCF) ) THEN + FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, seast_interp_m, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + 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 ) + IF ( ASSOCIATED(WaveField%WaveAccMCF) ) THEN + FAMCF(:) = SeaSt_Interp_4D_vec( WaveField%WaveAccMCF, seast_interp_m, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + ! Extrapoled wave stretching + IF (WaveField%WaveStMod == 2) THEN + FV(:) = FV(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%seast_interp_p, 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, 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, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ASSOCIATED(WaveField%WaveAccMCF) ) THEN + FAMCF(:) = FAMCF(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveAccMCF0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + 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 [-WtrDpth,m%WaveElev(j)] to [-WtrDpth,0] + posPrime = pos + posPrime(3) = WaveField%WtrDpth*(WaveField%WtrDpth+pos(3))/(WaveField%WtrDpth+WaveElev)-WaveField%WtrDpth + + ! 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 ) + IF ( ASSOCIATED(WaveField%WaveAccMCF) ) THEN + FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, seast_interp_m, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + END IF + + ELSE ! Node is out of water - zero-out all wave dynamics + + 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 + +END SUBROUTINE WaveField_GetWaveKin + +SUBROUTINE WaveField_End( WaveField ) + + TYPE(SeaSt_WaveFieldType), INTENT( INOUT ) :: WaveField + + ! Dissociate all pointers within WaveField and let SeaState deallocate the data + ! Temporary solution before the code is modified to exclusively use WaveField + NULLIFY( WaveField%WaveTime ) + NULLIFY( WaveField%WaveDynP ) + NULLIFY( WaveField%WaveAcc ) + NULLIFY( WaveField%WaveAccMCF ) + NULLIFY( WaveField%WaveVel ) + NULLIFY( WaveField%PWaveDynP0 ) + NULLIFY( WaveField%PWaveAcc0 ) + NULLIFY( WaveField%PWaveAccMCF0 ) + NULLIFY( WaveField%PWaveVel0 ) + NULLIFY( WaveField%WaveElev1 ) + NULLIFY( WaveField%WaveElev2 ) + +END SUBROUTINE WaveField_End + +END MODULE SeaSt_WaveField diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt new file mode 100644 index 0000000000..0ae7593c33 --- /dev/null +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -0,0 +1,21 @@ +#---------------------------------------------------------------------------------------------------------------------------------- +# Data structures for representing wave fields. +# +usefrom SeaState_Interp.txt +#---------------------------------------------------------------------------------------------------------------------------------- +# +#---------------------------------------------------------------------------------------------------------------------------------- +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) +typedef ^ ^ SiKi WaveAccMCF {*}{*}{*}{*}{*} - - "Scaled acceleration for MacCamy-Fuchs members" (m/s^2) +typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Incident wave velocity" (m/s) +typedef ^ ^ SiKi PWaveDynP0 {*}{*}{*} - - "Partial derivative of dynamic pressure in the vertical direction at the still water level" (Pa/m) +typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "Partial derivative of incident wave acceleration in the vertical direction at the still water level" (m/s^2/m) +typedef ^ ^ SiKi PWaveAccMCF0 {*}{*}{*}{*} - - "Partial derivative of scaled wave acceleration in the vertical direction at the still water level for MacCamy-Fuchs members" (m/s^2/m) +typedef ^ ^ SiKi PWaveVel0 {*}{*}{*}{*} - - "Partial derivative of incident wave velocity in the vertical direction at the still water level" (m/s/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 ^ ^ IntKi WaveStMod - - - "Wave stretching model" +typedef ^ ^ ReKi WtrDpth - - - "Water depth" (-) diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 new file mode 100644 index 0000000000..a46f4bc33e --- /dev/null +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -0,0 +1,1266 @@ +!STARTOFREGISTRYGENERATEDFILE 'SeaSt_WaveField_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 +!********************************************************************************************************************************* +! SeaSt_WaveField_Types +!................................................................................................................................. +! This file is part of SeaSt_WaveField. +! +! 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 SeaSt_WaveField. 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 SeaSt_WaveField_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE SeaState_Interp_Types +USE NWTC_Library +IMPLICIT NONE +! ========= SeaSt_WaveFieldType ======= + TYPE, PUBLIC :: SeaSt_WaveFieldType + REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Time array [(s)] + REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: WaveDynP => NULL() !< Incident wave dynamic pressure [(N/m^2)] + REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Incident wave acceleration [(m/s^2)] + REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAccMCF => NULL() !< Scaled acceleration for MacCamy-Fuchs members [(m/s^2)] + REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Incident wave velocity [(m/s)] + REAL(SiKi) , DIMENSION(:,:,:), POINTER :: PWaveDynP0 => NULL() !< Partial derivative of dynamic pressure in the vertical direction at the still water level [(Pa/m)] + REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< Partial derivative of incident wave acceleration in the vertical direction at the still water level [(m/s^2/m)] + REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAccMCF0 => NULL() !< Partial derivative of scaled wave acceleration in the vertical direction at the still water level for MacCamy-Fuchs members [(m/s^2/m)] + REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveVel0 => NULL() !< Partial derivative of incident wave velocity in the vertical direction at the still water level [(m/s/m)] + REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation [(m)] + REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation [(m)] + TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< Parameter information from the SeaState Interpolation module [(-)] + INTEGER(IntKi) :: WaveStMod !< Wave stretching model [-] + REAL(ReKi) :: WtrDpth !< Water depth [(-)] + END TYPE SeaSt_WaveFieldType +! ======================= +CONTAINS + 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 + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_WaveField_CopySeaSt_WaveFieldType' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%WaveTime)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveTime,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveTime,1) + IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%WaveTime)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveTime(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveTime.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%WaveTime = SrcSeaSt_WaveFieldTypeData%WaveTime +ENDIF +IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%WaveDynP)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,3) + i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,4) + i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,4) + IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%WaveDynP)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveDynP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%WaveDynP = SrcSeaSt_WaveFieldTypeData%WaveDynP +ENDIF +IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%WaveAcc)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,3) + i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,4) + i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,4) + i5_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,5) + i5_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,5) + IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%WaveAcc)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveAcc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%WaveAcc = SrcSeaSt_WaveFieldTypeData%WaveAcc +ENDIF +IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%WaveAccMCF)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,3) + i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,4) + i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,4) + i5_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,5) + i5_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,5) + IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%WaveAccMCF)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%WaveAccMCF = SrcSeaSt_WaveFieldTypeData%WaveAccMCF +ENDIF +IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%WaveVel)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,3) + i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,4) + i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,4) + i5_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,5) + i5_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,5) + IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%WaveVel)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveVel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%WaveVel = SrcSeaSt_WaveFieldTypeData%WaveVel +ENDIF +IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%PWaveDynP0)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,3) + IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%PWaveDynP0)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%PWaveDynP0 = SrcSeaSt_WaveFieldTypeData%PWaveDynP0 +ENDIF +IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%PWaveAcc0)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,3) + i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,4) + i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,4) + IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%PWaveAcc0)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%PWaveAcc0 = SrcSeaSt_WaveFieldTypeData%PWaveAcc0 +ENDIF +IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,3) + i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,4) + i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,4) + IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%PWaveAccMCF0 = SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0 +ENDIF +IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%PWaveVel0)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,3) + i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,4) + i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,4) + IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%PWaveVel0)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%PWaveVel0 = SrcSeaSt_WaveFieldTypeData%PWaveVel0 +ENDIF +IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%WaveElev1)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,3) + IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%WaveElev1)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElev1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%WaveElev1 = SrcSeaSt_WaveFieldTypeData%WaveElev1 +ENDIF +IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%WaveElev2)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,3) + IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%WaveElev2)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElev2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%WaveElev2 = SrcSeaSt_WaveFieldTypeData%WaveElev2 +ENDIF + CALL SeaSt_Interp_CopyParam( SrcSeaSt_WaveFieldTypeData%SeaSt_Interp_p, DstSeaSt_WaveFieldTypeData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstSeaSt_WaveFieldTypeData%WaveStMod = SrcSeaSt_WaveFieldTypeData%WaveStMod + DstSeaSt_WaveFieldTypeData%WtrDpth = SrcSeaSt_WaveFieldTypeData%WtrDpth + END SUBROUTINE SeaSt_WaveField_CopySeaSt_WaveFieldType + + SUBROUTINE SeaSt_WaveField_DestroySeaSt_WaveFieldType( SeaSt_WaveFieldTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: SeaSt_WaveFieldTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_WaveField_DestroySeaSt_WaveFieldType' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ASSOCIATED(SeaSt_WaveFieldTypeData%WaveTime)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(SeaSt_WaveFieldTypeData%WaveTime) + SeaSt_WaveFieldTypeData%WaveTime => NULL() +ENDIF +IF (ASSOCIATED(SeaSt_WaveFieldTypeData%WaveDynP)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(SeaSt_WaveFieldTypeData%WaveDynP) + SeaSt_WaveFieldTypeData%WaveDynP => NULL() +ENDIF +IF (ASSOCIATED(SeaSt_WaveFieldTypeData%WaveAcc)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(SeaSt_WaveFieldTypeData%WaveAcc) + SeaSt_WaveFieldTypeData%WaveAcc => NULL() +ENDIF +IF (ASSOCIATED(SeaSt_WaveFieldTypeData%WaveAccMCF)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(SeaSt_WaveFieldTypeData%WaveAccMCF) + SeaSt_WaveFieldTypeData%WaveAccMCF => NULL() +ENDIF +IF (ASSOCIATED(SeaSt_WaveFieldTypeData%WaveVel)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(SeaSt_WaveFieldTypeData%WaveVel) + SeaSt_WaveFieldTypeData%WaveVel => NULL() +ENDIF +IF (ASSOCIATED(SeaSt_WaveFieldTypeData%PWaveDynP0)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(SeaSt_WaveFieldTypeData%PWaveDynP0) + SeaSt_WaveFieldTypeData%PWaveDynP0 => NULL() +ENDIF +IF (ASSOCIATED(SeaSt_WaveFieldTypeData%PWaveAcc0)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(SeaSt_WaveFieldTypeData%PWaveAcc0) + SeaSt_WaveFieldTypeData%PWaveAcc0 => NULL() +ENDIF +IF (ASSOCIATED(SeaSt_WaveFieldTypeData%PWaveAccMCF0)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(SeaSt_WaveFieldTypeData%PWaveAccMCF0) + SeaSt_WaveFieldTypeData%PWaveAccMCF0 => NULL() +ENDIF +IF (ASSOCIATED(SeaSt_WaveFieldTypeData%PWaveVel0)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(SeaSt_WaveFieldTypeData%PWaveVel0) + SeaSt_WaveFieldTypeData%PWaveVel0 => NULL() +ENDIF +IF (ASSOCIATED(SeaSt_WaveFieldTypeData%WaveElev1)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(SeaSt_WaveFieldTypeData%WaveElev1) + SeaSt_WaveFieldTypeData%WaveElev1 => NULL() +ENDIF +IF (ASSOCIATED(SeaSt_WaveFieldTypeData%WaveElev2)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(SeaSt_WaveFieldTypeData%WaveElev2) + SeaSt_WaveFieldTypeData%WaveElev2 => NULL() +ENDIF + CALL SeaSt_Interp_DestroyParam( SeaSt_WaveFieldTypeData%SeaSt_Interp_p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE SeaSt_WaveField_DestroySeaSt_WaveFieldType + + SUBROUTINE SeaSt_WaveField_PackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SeaSt_WaveFieldType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_WaveField_PackSeaSt_WaveFieldType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no + IF ( ASSOCIATED(InData%WaveTime) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime + END IF + Int_BufSz = Int_BufSz + 1 ! WaveDynP allocated yes/no + IF ( ASSOCIATED(InData%WaveDynP) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! WaveDynP upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP) ! WaveDynP + END IF + Int_BufSz = Int_BufSz + 1 ! WaveAcc allocated yes/no + IF ( ASSOCIATED(InData%WaveAcc) ) THEN + Int_BufSz = Int_BufSz + 2*5 ! WaveAcc upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc) ! WaveAcc + END IF + Int_BufSz = Int_BufSz + 1 ! WaveAccMCF allocated yes/no + IF ( ASSOCIATED(InData%WaveAccMCF) ) THEN + Int_BufSz = Int_BufSz + 2*5 ! WaveAccMCF upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveAccMCF) ! WaveAccMCF + END IF + Int_BufSz = Int_BufSz + 1 ! WaveVel allocated yes/no + IF ( ASSOCIATED(InData%WaveVel) ) THEN + Int_BufSz = Int_BufSz + 2*5 ! WaveVel upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveVel) ! WaveVel + END IF + Int_BufSz = Int_BufSz + 1 ! PWaveDynP0 allocated yes/no + IF ( ASSOCIATED(InData%PWaveDynP0) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! PWaveDynP0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PWaveDynP0) ! PWaveDynP0 + END IF + Int_BufSz = Int_BufSz + 1 ! PWaveAcc0 allocated yes/no + IF ( ASSOCIATED(InData%PWaveAcc0) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! PWaveAcc0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PWaveAcc0) ! PWaveAcc0 + END IF + Int_BufSz = Int_BufSz + 1 ! PWaveAccMCF0 allocated yes/no + IF ( ASSOCIATED(InData%PWaveAccMCF0) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! PWaveAccMCF0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PWaveAccMCF0) ! PWaveAccMCF0 + END IF + Int_BufSz = Int_BufSz + 1 ! PWaveVel0 allocated yes/no + IF ( ASSOCIATED(InData%PWaveVel0) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! PWaveVel0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PWaveVel0) ! PWaveVel0 + END IF + Int_BufSz = Int_BufSz + 1 ! WaveElev1 allocated yes/no + IF ( ASSOCIATED(InData%WaveElev1) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! WaveElev1 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElev1) ! WaveElev1 + END IF + Int_BufSz = Int_BufSz + 1 ! WaveElev2 allocated yes/no + IF ( ASSOCIATED(InData%WaveElev2) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! WaveElev2 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElev2) ! WaveElev2 + END IF + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_p: size of buffers for each call to pack subtype + CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt_Interp_p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SeaSt_Interp_p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SeaSt_Interp_p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SeaSt_Interp_p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! WaveStMod + Re_BufSz = Re_BufSz + 1 ! WtrDpth + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ASSOCIATED(InData%WaveTime) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%WaveDynP) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%WaveDynP,4), UBOUND(InData%WaveDynP,4) + DO i3 = LBOUND(InData%WaveDynP,3), UBOUND(InData%WaveDynP,3) + DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) + DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%WaveAcc) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,4) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,5) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,5) + Int_Xferred = Int_Xferred + 2 + + DO i5 = LBOUND(InData%WaveAcc,5), UBOUND(InData%WaveAcc,5) + DO i4 = LBOUND(InData%WaveAcc,4), UBOUND(InData%WaveAcc,4) + DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) + DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) + DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3,i4,i5) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%WaveAccMCF) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,4) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,5) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,5) + Int_Xferred = Int_Xferred + 2 + + DO i5 = LBOUND(InData%WaveAccMCF,5), UBOUND(InData%WaveAccMCF,5) + DO i4 = LBOUND(InData%WaveAccMCF,4), UBOUND(InData%WaveAccMCF,4) + DO i3 = LBOUND(InData%WaveAccMCF,3), UBOUND(InData%WaveAccMCF,3) + DO i2 = LBOUND(InData%WaveAccMCF,2), UBOUND(InData%WaveAccMCF,2) + DO i1 = LBOUND(InData%WaveAccMCF,1), UBOUND(InData%WaveAccMCF,1) + ReKiBuf(Re_Xferred) = InData%WaveAccMCF(i1,i2,i3,i4,i5) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%WaveVel) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,4) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,5) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,5) + Int_Xferred = Int_Xferred + 2 + + DO i5 = LBOUND(InData%WaveVel,5), UBOUND(InData%WaveVel,5) + DO i4 = LBOUND(InData%WaveVel,4), UBOUND(InData%WaveVel,4) + DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) + DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) + DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) + ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3,i4,i5) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%PWaveDynP0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%PWaveDynP0,3), UBOUND(InData%PWaveDynP0,3) + DO i2 = LBOUND(InData%PWaveDynP0,2), UBOUND(InData%PWaveDynP0,2) + DO i1 = LBOUND(InData%PWaveDynP0,1), UBOUND(InData%PWaveDynP0,1) + ReKiBuf(Re_Xferred) = InData%PWaveDynP0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%PWaveAcc0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%PWaveAcc0,4), UBOUND(InData%PWaveAcc0,4) + DO i3 = LBOUND(InData%PWaveAcc0,3), UBOUND(InData%PWaveAcc0,3) + DO i2 = LBOUND(InData%PWaveAcc0,2), UBOUND(InData%PWaveAcc0,2) + DO i1 = LBOUND(InData%PWaveAcc0,1), UBOUND(InData%PWaveAcc0,1) + ReKiBuf(Re_Xferred) = InData%PWaveAcc0(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%PWaveAccMCF0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%PWaveAccMCF0,4), UBOUND(InData%PWaveAccMCF0,4) + DO i3 = LBOUND(InData%PWaveAccMCF0,3), UBOUND(InData%PWaveAccMCF0,3) + DO i2 = LBOUND(InData%PWaveAccMCF0,2), UBOUND(InData%PWaveAccMCF0,2) + DO i1 = LBOUND(InData%PWaveAccMCF0,1), UBOUND(InData%PWaveAccMCF0,1) + ReKiBuf(Re_Xferred) = InData%PWaveAccMCF0(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%PWaveVel0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%PWaveVel0,4), UBOUND(InData%PWaveVel0,4) + DO i3 = LBOUND(InData%PWaveVel0,3), UBOUND(InData%PWaveVel0,3) + DO i2 = LBOUND(InData%PWaveVel0,2), UBOUND(InData%PWaveVel0,2) + DO i1 = LBOUND(InData%PWaveVel0,1), UBOUND(InData%PWaveVel0,1) + ReKiBuf(Re_Xferred) = InData%PWaveVel0(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%WaveElev1) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%WaveElev1,3), UBOUND(InData%WaveElev1,3) + DO i2 = LBOUND(InData%WaveElev1,2), UBOUND(InData%WaveElev1,2) + DO i1 = LBOUND(InData%WaveElev1,1), UBOUND(InData%WaveElev1,1) + ReKiBuf(Re_Xferred) = InData%WaveElev1(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%WaveElev2) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%WaveElev2,3), UBOUND(InData%WaveElev2,3) + DO i2 = LBOUND(InData%WaveElev2,2), UBOUND(InData%WaveElev2,2) + DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) + ReKiBuf(Re_Xferred) = InData%WaveElev2(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IntKiBuf(Int_Xferred) = InData%WaveStMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE SeaSt_WaveField_PackSeaSt_WaveFieldType + + SUBROUTINE SeaSt_WaveField_UnPackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_WaveField_UnPackSeaSt_WaveFieldType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) + ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%WaveDynP)) DEALLOCATE(OutData%WaveDynP) + ALLOCATE(OutData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%WaveDynP,4), UBOUND(OutData%WaveDynP,4) + DO i3 = LBOUND(OutData%WaveDynP,3), UBOUND(OutData%WaveDynP,3) + DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) + DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) + OutData%WaveDynP(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i5_l = IntKiBuf( Int_Xferred ) + i5_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%WaveAcc)) DEALLOCATE(OutData%WaveAcc) + ALLOCATE(OutData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i5 = LBOUND(OutData%WaveAcc,5), UBOUND(OutData%WaveAcc,5) + DO i4 = LBOUND(OutData%WaveAcc,4), UBOUND(OutData%WaveAcc,4) + DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) + DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) + DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) + OutData%WaveAcc(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAccMCF not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i5_l = IntKiBuf( Int_Xferred ) + i5_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%WaveAccMCF)) DEALLOCATE(OutData%WaveAccMCF) + ALLOCATE(OutData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i5 = LBOUND(OutData%WaveAccMCF,5), UBOUND(OutData%WaveAccMCF,5) + DO i4 = LBOUND(OutData%WaveAccMCF,4), UBOUND(OutData%WaveAccMCF,4) + DO i3 = LBOUND(OutData%WaveAccMCF,3), UBOUND(OutData%WaveAccMCF,3) + DO i2 = LBOUND(OutData%WaveAccMCF,2), UBOUND(OutData%WaveAccMCF,2) + DO i1 = LBOUND(OutData%WaveAccMCF,1), UBOUND(OutData%WaveAccMCF,1) + OutData%WaveAccMCF(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i5_l = IntKiBuf( Int_Xferred ) + i5_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%WaveVel)) DEALLOCATE(OutData%WaveVel) + ALLOCATE(OutData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i5 = LBOUND(OutData%WaveVel,5), UBOUND(OutData%WaveVel,5) + DO i4 = LBOUND(OutData%WaveVel,4), UBOUND(OutData%WaveVel,4) + DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) + DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) + DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) + OutData%WaveVel(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveDynP0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%PWaveDynP0)) DEALLOCATE(OutData%PWaveDynP0) + ALLOCATE(OutData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%PWaveDynP0,3), UBOUND(OutData%PWaveDynP0,3) + DO i2 = LBOUND(OutData%PWaveDynP0,2), UBOUND(OutData%PWaveDynP0,2) + DO i1 = LBOUND(OutData%PWaveDynP0,1), UBOUND(OutData%PWaveDynP0,1) + OutData%PWaveDynP0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAcc0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%PWaveAcc0)) DEALLOCATE(OutData%PWaveAcc0) + ALLOCATE(OutData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%PWaveAcc0,4), UBOUND(OutData%PWaveAcc0,4) + DO i3 = LBOUND(OutData%PWaveAcc0,3), UBOUND(OutData%PWaveAcc0,3) + DO i2 = LBOUND(OutData%PWaveAcc0,2), UBOUND(OutData%PWaveAcc0,2) + DO i1 = LBOUND(OutData%PWaveAcc0,1), UBOUND(OutData%PWaveAcc0,1) + OutData%PWaveAcc0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAccMCF0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%PWaveAccMCF0)) DEALLOCATE(OutData%PWaveAccMCF0) + ALLOCATE(OutData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%PWaveAccMCF0,4), UBOUND(OutData%PWaveAccMCF0,4) + DO i3 = LBOUND(OutData%PWaveAccMCF0,3), UBOUND(OutData%PWaveAccMCF0,3) + DO i2 = LBOUND(OutData%PWaveAccMCF0,2), UBOUND(OutData%PWaveAccMCF0,2) + DO i1 = LBOUND(OutData%PWaveAccMCF0,1), UBOUND(OutData%PWaveAccMCF0,1) + OutData%PWaveAccMCF0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveVel0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%PWaveVel0)) DEALLOCATE(OutData%PWaveVel0) + ALLOCATE(OutData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%PWaveVel0,4), UBOUND(OutData%PWaveVel0,4) + DO i3 = LBOUND(OutData%PWaveVel0,3), UBOUND(OutData%PWaveVel0,3) + DO i2 = LBOUND(OutData%PWaveVel0,2), UBOUND(OutData%PWaveVel0,2) + DO i1 = LBOUND(OutData%PWaveVel0,1), UBOUND(OutData%PWaveVel0,1) + OutData%PWaveVel0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev1 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%WaveElev1)) DEALLOCATE(OutData%WaveElev1) + ALLOCATE(OutData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%WaveElev1,3), UBOUND(OutData%WaveElev1,3) + DO i2 = LBOUND(OutData%WaveElev1,2), UBOUND(OutData%WaveElev1,2) + DO i1 = LBOUND(OutData%WaveElev1,1), UBOUND(OutData%WaveElev1,1) + OutData%WaveElev1(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev2 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%WaveElev2)) DEALLOCATE(OutData%WaveElev2) + ALLOCATE(OutData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%WaveElev2,3), UBOUND(OutData%WaveElev2,3) + DO i2 = LBOUND(OutData%WaveElev2,2), UBOUND(OutData%WaveElev2,2) + DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) + OutData%WaveElev2(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SeaSt_Interp_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) ! SeaSt_Interp_p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%WaveStMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE SeaSt_WaveField_UnPackSeaSt_WaveFieldType + +END MODULE SeaSt_WaveField_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 72290c4607..2eeaaa54f9 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -21,17 +21,20 @@ ! 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. -! +! rning generating S !********************************************************************************************************************************** MODULE SeaState USE SeaState_Types USE NWTC_Library + USE SeaSt_WaveField USE SeaState_Input USE SeaState_Output use SeaState_Interp USE Current USE Waves2 + + IMPLICIT NONE @@ -90,7 +93,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init TYPE(SeaSt_Interp_InitInputType) :: SeaSt_Interp_InitInp ! TYPE(Waves2_InitOutputType) :: Waves2_InitOut ! Initialization Outputs from the Waves2 module initialization TYPE(Current_InitOutputType) :: Current_InitOut ! Initialization Outputs from the Current module initialization - INTEGER :: I ! Generic counters + INTEGER :: I,J,K ! Generic counters INTEGER :: it ! Generic counters REAL(ReKi) :: TmpElev ! temporary wave elevation @@ -231,6 +234,19 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WaveDirArr => Waves_InitOut%WaveDirArr p%PWaveAccMCF0 => Waves_InitOut%PWaveAccMCF0 + p%WaveField%WtrDpth = p%WtrDpth + p%WaveField%WaveStMod = p%WaveStMod + p%WaveField%WaveTime => Waves_InitOut%WaveTime + 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 + p%WaveField%WaveAccMCF => Waves_InitOut%WaveAccMCF + p%WaveField%PWaveAccMCF0 => Waves_InitOut%PWaveAccMCF0 + ! check error (must be done AFTER moving pointers to parameters) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -299,6 +315,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init CALL Waves2_Init(InputFileData%Waves2, p%Waves2, Waves2_InitOut, ErrStat2, ErrMsg2 ) p%WaveElev2 => Waves2_InitOut%WaveElev2 ! do this before calling cleanup() so that pointers get deallocated properly + p%WaveField%WaveElev2 => Waves2_InitOut%WaveElev2 CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN @@ -458,8 +475,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init END IF ! Check for WaveMod = 6 - - ! Create the Output file if requested p%OutSwtch = InputFileData%OutSwtch p%Delim = '' @@ -501,6 +516,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init 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%seast_interp_p, ErrStat2, ErrMsg2) + CALL SeaSt_Interp_CopyParam( p%seast_interp_p, p%WaveField%seast_interp_p, 0, ErrStat2, ErrMsg2 ) 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! @@ -690,7 +706,7 @@ SUBROUTINE SeaSt_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ! Place any last minute operations or calculations here: - + CALL WaveField_End(p%WaveField) ! Write the SeaState-level output file data FROM THE LAST COMPLETED TIME STEP if the user requested module-level output @@ -801,13 +817,14 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er REAL(ReKi) :: AllOuts(MaxOutPts) real(ReKi) :: positionXYZ(3), positionXY(2) - REAL(ReKi) :: zeta - REAL(ReKi) :: zeta1 - REAL(ReKi) :: zeta2 + REAL(SiKi) :: zeta + REAL(SiKi) :: zeta1 + REAL(SiKi) :: zeta2 REAL(SiKi) :: zp REAL(ReKi) :: positionXYZp(3) REAL(ReKi) :: positionXY0(3) + INTEGER(IntKi) :: nodeInWater ! Initialize ErrStat @@ -824,7 +841,7 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er ! These Outputs are only used for generated user-requested output channel results. ! If the user did not request any outputs, then we can simply return - if ( p%NumOuts > 0 ) then + IF ( p%NumOuts > 0 ) THEN ! Write the SeaState-level output file data FROM THE LAST COMPLETED TIME STEP if the user requested module-level output ! and the current time has advanced since the last stored time step. Note that this must be done before filling y%WriteOutput @@ -837,141 +854,24 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er END IF m%LastOutTime = Time ! time associated with next WriteOutput calculations - - !------------------------------------------------------------------- - ! Additional stiffness, damping forces. These need to be placed on a point mesh which is located at the WAMIT reference point (WRP). - ! This mesh will need to get mapped by the glue code for use by either ElastoDyn or SubDyn. - !------------------------------------------------------------------- - DO i = 1, p%NWaveKin positionXYZ = (/p%WaveKinxi(i),p%WaveKinyi(i),p%WaveKinzi(i)/) - IF (p%WaveStMod > 0) THEN ! Wave stretching enabled - positionXY = (/p%WaveKinxi(i),p%WaveKinyi(i)/) - zeta1 = SeaSt_Interp_3D( Time, positionXY, p%WaveElev1, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (associated(p%WaveElev2)) THEN - zeta2 = SeaSt_Interp_3D( Time, positionXY, p%WaveElev2, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - zeta = zeta1 + zeta2 - ELSE - zeta = zeta1 - END IF - - IF (p%WaveKinzi(i) <= zeta) THEN ! Probe in water - IF (p%WaveStMod < 3) THEN ! Vertical or extrapolation stretching - IF (p%WaveKinzi(i)<=0.0) THEN ! Probe is below SWL - ! Evaluate wave kinematics as usual - CALL SeaSt_Interp_Setup( Time, positionXYZ, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveVel(:,i) = SeaSt_Interp_4D_Vec( p%WaveVel, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveAcc(:,i) = SeaSt_Interp_4D_Vec( p%WaveAcc, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (associated(p%WaveAccMCF)) THEN - WaveAccMCF(:,i) = SeaSt_Interp_4D_Vec( p%WaveAccMCF, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - WaveDynP(i) = SeaSt_Interp_4D ( p%WaveDynP, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSE ! Probe is above SWL - ! Get wave kinematics at the SWL first - positionXY0 = (/p%WaveKinxi(i),p%WaveKinyi(i),-0.00001_SiKi/) - CALL SeaSt_Interp_Setup( Time, positionXY0, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveVel(:,i) = SeaSt_Interp_4D_Vec( p%WaveVel, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveAcc(:,i) = SeaSt_Interp_4D_Vec( p%WaveAcc, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (associated(p%WaveAccMCF)) THEN - WaveAccMCF(:,i) = SeaSt_Interp_4D_Vec( p%WaveAccMCF, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - WaveDynP(i) = SeaSt_Interp_4D ( p%WaveDynP, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (p%WaveStMod == 2) THEN ! extrapolation stretching - ! Extrapolate - WaveVel(:,i) = WaveVel(:,i) + SeaSt_Interp_3D_Vec( Time, positionXY, p%PWaveVel0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * p%WaveKinzi(i) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveAcc(:,i) = WaveAcc(:,i) + SeaSt_Interp_3D_Vec( Time, positionXY, p%PWaveAcc0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * p%WaveKinzi(i) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (associated(p%WaveAccMCF)) THEN - WaveAccMCF(:,i) = WaveAcc(:,i) + SeaSt_Interp_3D_Vec( Time, positionXY, p%PWaveAccMCF0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * p%WaveKinzi(i) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - WaveDynP(i) = WaveDynP(i) + SeaSt_Interp_3D ( Time, positionXY, p%PWaveDynP0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * p%WaveKinzi(i) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - END IF - ELSE IF (p%WaveStMod == 3) THEN ! Wheeler stretching - ! Evaluate wave kinematics based on the re-mapped z-position - zp = p%WtrDpth * ( p%WtrDpth + p%WaveKinzi(i) )/( p%WtrDpth + zeta ) - p%WtrDpth - positionXYZp = (/p%WaveKinxi(i),p%WaveKinyi(i),zp/) - CALL SeaSt_Interp_Setup( Time, positionXYZp, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveVel(:,i) = SeaSt_Interp_4D_Vec( p%WaveVel, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveAcc(:,i) = SeaSt_Interp_4D_Vec( p%WaveAcc, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (associated(p%WaveAccMCF)) THEN - WaveAccMCF(:,i) = SeaSt_Interp_4D_Vec( p%WaveAccMCF, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - WaveDynP(i) = SeaSt_Interp_4D ( p%WaveDynP, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - ELSE ! Probe out of water - ! Zero everthing - WaveVel(:,i) = (/0.0,0.0,0.0/) - WaveAcc(:,i) = (/0.0,0.0,0.0/) - WaveDynP(i) = 0.0 - END IF - ELSE ! No wave stretching - IF (p%WaveKinzi(i)<=0) THEN ! Probe at or below SWL - IF (EqualRealNos(p%WaveKinzi(i),0.0_SiKi)) THEN - positionXYZ(3) = -0.000001_SiKi - END IF - ! Evaluate wave kinematics as usual - CALL SeaSt_Interp_Setup( Time, positionXYZ, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveVel(:,i) = SeaSt_Interp_4D_Vec( p%WaveVel, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveAcc(:,i) = SeaSt_Interp_4D_Vec( p%WaveAcc, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (associated(p%WaveAccMCF)) THEN - WaveAccMCF(:,i) = SeaSt_Interp_4D_Vec( p%WaveAccMCF, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - WaveDynP(i) = SeaSt_Interp_4D ( p%WaveDynP, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSE ! Probe above SWL - ! Zero everthing - WaveVel(:,i) = (/0.0,0.0,0.0/) - WaveAcc(:,i) = (/0.0,0.0,0.0/) - WaveDynP(i) = 0.0 - END IF - END IF + CALL WaveField_GetWaveKin( p%WaveField, Time, positionXYZ, nodeInWater, zeta1, zeta2, zeta, WaveDynP(i), WaveVel(:,i), WaveAcc(:,i), WaveAccMCF(:,i), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO ! Compute the wave elevations at the requested output locations for this time. Note that p%WaveElev has the second order added to it already. - do i = 1, p%NWaveElev + DO i = 1, p%NWaveElev positionXY = (/p%WaveElevxi(i),p%WaveElevyi(i)/) - - WaveElev1(i) = SeaSt_Interp_3D( Time, positionXY, p%WaveElev1, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - if (associated(p%WaveElev2)) then - WaveElev2(i) = SeaSt_Interp_3D( Time, positionXY, p%WaveElev2, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveElev(i) = WaveElev1(i) + WaveElev2(i) - else - WaveElev(i) = WaveElev1(i) - end if - - end do - + WaveElev1(i) = WaveField_GetWaveElev1( p%WaveField, Time, positionXY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + WaveElev2(i) = WaveField_GetWaveElev2( p%WaveField, Time, positionXY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + WaveElev(i) = WaveElev1(i) + WaveElev2(i) + END DO - ! Map calculated results into the AllOuts Array + ! Map calculated results into the AllOuts Array CALL SeaStOut_MapOutputs( p, WaveElev, WaveElev1, WaveElev2, WaveVel, WaveAcc, WaveAccMCF, WaveDynP, AllOuts, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -979,7 +879,7 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er y%WriteOutput(I) = p%OutParam(I)%SignM * AllOuts( p%OutParam(I)%Indx ) END DO - end if + END IF END SUBROUTINE SeaSt_CalcOutput diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index de2576d62a..5c957585d7 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -18,6 +18,7 @@ usefrom Current.txt usefrom Waves.txt usefrom Waves2.txt usefrom SeaState_Interp.txt +usefrom SeaSt_WaveField.txt # # typedef SeaState/SeaSt SeaSt_InputFile LOGICAL EchoFlag - - - "Echo the input file" @@ -187,6 +188,7 @@ typedef ^ ^ CHARACTER(1) Del typedef ^ ^ INTEGER UnOutFile - - - "File unit for the SeaState outputs" - typedef ^ ^ INTEGER OutDec - - - "Write every OutDec time steps" - typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - +typedef ^ ^ SeaSt_WaveFieldType WaveField - - - "Wave field" # # # ..... Inputs .................................................................................................................... diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 472ba3f22e..c0756af2df 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -34,7 +34,7 @@ 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 ! ========= SeaSt_InputFile ======= @@ -204,6 +204,7 @@ MODULE SeaState_Types INTEGER(IntKi) :: UnOutFile !< File unit for the SeaState outputs [-] INTEGER(IntKi) :: OutDec !< Write every OutDec time steps [-] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] + TYPE(SeaSt_WaveFieldType) :: WaveField !< Wave field [-] END TYPE SeaSt_ParameterType ! ======================= ! ========= SeaSt_InputType ======= @@ -4421,6 +4422,9 @@ SUBROUTINE SeaSt_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs CALL SeaSt_Interp_CopyParam( SrcParamData%SeaSt_Interp_p, DstParamData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL SeaSt_WaveField_Copyseast_wavefieldtype( SrcParamData%WaveField, DstParamData%WaveField, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE SeaSt_CopyParam SUBROUTINE SeaSt_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) @@ -4535,6 +4539,8 @@ SUBROUTINE SeaSt_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF CALL SeaSt_Interp_DestroyParam( ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL SeaSt_WaveField_Destroyseast_wavefieldtype( ParamData%WaveField, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SeaSt_DestroyParam SUBROUTINE SeaSt_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -4740,6 +4746,23 @@ SUBROUTINE SeaSt_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! WaveField: size of buffers for each call to pack subtype + CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! WaveField + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! WaveField + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! WaveField + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -5339,6 +5362,34 @@ SUBROUTINE SeaSt_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END SUBROUTINE SeaSt_PackParam SUBROUTINE SeaSt_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6041,6 +6092,46 @@ SUBROUTINE SeaSt_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SeaSt_WaveField_Unpackseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE SeaSt_UnPackParam SUBROUTINE SeaSt_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) From 9af7fb1af76c62a1f7211396152687725877315d Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Mon, 22 May 2023 17:34:45 -0600 Subject: [PATCH 02/12] Copy SeaSt_WaveField to HydroDyn/Morison * Begin switching to SeaSt_WaveField when querying the wave kinematics. * The copying of SeaSt_WaveField is only temporary. Will switch to passing pointers in the future. --- modules/hydrodyn/src/HydroDyn.f90 | 5 +- modules/hydrodyn/src/HydroDyn.txt | 2 + modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 4 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 91 ++++ modules/hydrodyn/src/Morison.f90 | 417 +++++++++--------- modules/hydrodyn/src/Morison.txt | 3 + modules/hydrodyn/src/Morison_Types.f90 | 184 +++++++- modules/openfast-library/src/FAST_Subs.f90 | 3 + modules/seastate/src/SeaSt_WaveField.f90 | 15 +- modules/seastate/src/SeaSt_WaveField.txt | 3 +- .../seastate/src/SeaSt_WaveField_Types.f90 | 17 +- modules/seastate/src/SeaState.f90 | 44 +- modules/seastate/src/SeaState.txt | 1 + modules/seastate/src/SeaState_Types.f90 | 91 ++++ 14 files changed, 642 insertions(+), 238 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index e1ef0997db..bb2d3f23e7 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -30,7 +30,7 @@ MODULE HydroDyn use Morison USE WAMIT USE WAMIT2 - use SeaState + USE SeaState USE HydroDyn_Input USE HydroDyn_Output @@ -608,11 +608,12 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I InputFileData%Morison%WaveStMod = InitInp%WaveStMod + CALL SeaSt_WaveField_CopySeaSt_WaveFieldType( InitInp%WaveField, InputFileData%Morison%WaveField, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + ! If we did some second order wave kinematics corrections to the acceleration, velocity or ! dynamic pressure using the Waves2 module, then we need to add these to the values that we ! will be passing into the Morrison module. - InputFileData%Morison%seast_interp_p = InitInp%seast_interp_p ! Initialize the Morison Element Calculations diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index ab893ad5e7..7594c50709 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -23,6 +23,7 @@ usefrom SS_Excitation.txt usefrom WAMIT.txt usefrom WAMIT2.txt usefrom Morison.txt +usefrom SeaSt_WaveField.txt usefrom SeaState.txt #usefrom FIT.txt @@ -121,6 +122,7 @@ typedef ^ ^ LOGICAL WaveMultiDi typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - typedef ^ ^ SiKi MCFD - - - "Diameter of MacCamy-Fuchs members" (meters) +typedef ^ ^ SeaSt_WaveFieldType WaveField - - - "SeaState wave field" - # # # Define outputs from the initialization routine here: diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index 1f5b0f4ba3..05836f92ac 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -184,7 +184,6 @@ PROGRAM HydroDynDriver ErrStat = ErrID_Fatal call HD_DvrEnd() end if - ! Set HD Init Inputs based on SeaStates Init Outputs call SetHD_InitInputs() @@ -367,8 +366,9 @@ subroutine SetHD_InitInputs() InitInData_HD%WaveElev1 => InitOutData_SeaSt%WaveElev1 InitInData_HD%WaveElev2 => InitOutData_SeaSt%WaveElev2 - call SeaSt_Interp_CopyParam(InitOutData_SeaSt%SeaSt_Interp_p, InitInData_HD%SeaSt_Interp_p, MESH_NEWCOPY, ErrStat, ErrMsg ); CALL CheckError() + CALL SeaSt_Interp_CopyParam(InitOutData_SeaSt%SeaSt_Interp_p, InitInData_HD%SeaSt_Interp_p, MESH_NEWCOPY, ErrStat, ErrMsg ); CALL CheckError() + CALL SeaSt_WaveField_CopySeaSt_WaveFieldType( InitOutData_SeaSt%WaveField, InitInData_HD%WaveField, MESH_NEWCOPY, ErrStat, ErrMsg ) end subroutine SetHD_InitInputs !---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 41b2a62fbe..9287bd9bea 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -127,6 +127,7 @@ MODULE HydroDyn_Types REAL(SiKi) :: WaveDOmega !< Frequency step for incident wave calculations [(rad/s)] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] REAL(SiKi) :: MCFD !< Diameter of MacCamy-Fuchs members [(meters)] + TYPE(SeaSt_WaveFieldType) :: WaveField !< SeaState wave field [-] END TYPE HydroDyn_InitInputType ! ======================= ! ========= HydroDyn_InitOutputType ======= @@ -2042,6 +2043,9 @@ SUBROUTINE HydroDyn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN DstInitInputData%MCFD = SrcInitInputData%MCFD + CALL SeaSt_WaveField_Copyseast_wavefieldtype( SrcInitInputData%WaveField, DstInitInputData%WaveField, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE HydroDyn_CopyInitInput SUBROUTINE HydroDyn_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) @@ -2140,6 +2144,8 @@ SUBROUTINE HydroDyn_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATE ENDIF CALL SeaSt_Interp_DestroyParam( InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL SeaSt_WaveField_Destroyseast_wavefieldtype( InitInputData%WaveField, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE HydroDyn_DestroyInitInput SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2317,6 +2323,23 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Re_BufSz = Re_BufSz + 1 ! MCFD + Int_BufSz = Int_BufSz + 3 ! WaveField: size of buffers for each call to pack subtype + CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! WaveField + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! WaveField + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! WaveField + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -2854,6 +2877,34 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF ReKiBuf(Re_Xferred) = InData%MCFD Re_Xferred = Re_Xferred + 1 + CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END SUBROUTINE HydroDyn_PackInitInput SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3466,6 +3517,46 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) OutData%MCFD = REAL(ReKiBuf(Re_Xferred), SiKi) Re_Xferred = Re_Xferred + 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SeaSt_WaveField_Unpackseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE HydroDyn_UnPackInitInput SUBROUTINE HydroDyn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 155eaf4e1a..b7ce83ea43 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -23,7 +23,8 @@ MODULE Morison USE Waves USE Morison_Types USE Morison_Output - use SeaState_Interp + USE SeaState_Interp + USE SeaSt_WaveField ! USE HydroDyn_Output_Types USE NWTC_Library @@ -2466,7 +2467,8 @@ SUBROUTINE AllocateNodeLoadVariables(InitInp, p, m, NNodes, errStat, errMsg ) p%WaveAccMCF => InitInp%WaveAccMCF p%PWaveAccMCF0 => InitInp%PWaveAccMCF0 - + CALL SeaSt_WaveField_CopySeaSt_WaveFieldType( InitInp%WaveField, p%WaveField, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2644,7 +2646,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, INTEGER(IntKi) :: MemSubStat, NumFSX REAL(ReKi) :: theta1, theta2, dFdl(6), y_hat(3), z_hat(3), posMid(3), zetaMid, FSPt(3) INTEGER(IntKi) :: secStat - + REAL(SiKi) :: FDynP, FV(3), FA(3), FAMCF(3) LOGICAL :: Is1stElement ! Initialize errStat @@ -2671,212 +2673,229 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, END IF IF (p%WaveStMod > 0 .AND. p%WaveDisp /= 0) THEN ! Wave stretching enabled - pos1(3) = u%Mesh%Position(3,j) + u%Mesh%TranslationDisp(3,j) - p%MSL2SWL ! Use the current Z location. + pos1(3) = u%Mesh%Position(3,j) + u%Mesh%TranslationDisp(3,j) ! Use the current Z location. ELSE ! Wave stretching disabled - pos1(3) = u%Mesh%Position(3,j) - p%MSL2SWL ! We are intentionally using the undisplaced Z position of the node. + pos1(3) = u%Mesh%Position(3,j) ! We are intentionally using the undisplaced Z position of the node. END IF ! Compute the free surface elevation at the x/y position of all nodes - positionXY = (/pos1(1),pos1(2)/) - m%WaveElev1(j) = SeaSt_Interp_3D( Time, positionXY, p%WaveElev1, p%seast_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (associated(p%WaveElev2)) THEN - m%WaveElev2(j) = SeaSt_Interp_3D( Time, positionXY, p%WaveElev2, p%seast_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%WaveElev(j) = m%WaveElev1(j) + m%WaveElev2(j) - ELSE - m%WaveElev(j) = m%WaveElev1(j) - END IF - - IF (p%WaveStMod == 0) THEN ! No wave stretching - - IF ( pos1(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL - ! Use location to obtain interpolated values of kinematics - call SeaSt_Interp_Setup( Time, pos1, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%FV(:,j) = SeaSt_Interp_4D_Vec( p%WaveVel, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%FA(:,j) = SeaSt_Interp_4D_Vec( p%WaveAcc, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%FDynP(j) = SeaSt_Interp_4D ( p%WaveDynP, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%vrel(:,j) = m%FV(:,j) - u%Mesh%TranslationVel(:,j) - m%nodeInWater(j) = 1_IntKi - ELSE ! Node is above the SWL - m%FV(:,j) = 0.0 - m%FA(:,j) = 0.0 - m%FDynP(j) = 0.0 - m%vrel(:,j) = 0.0 - m%nodeInWater(j) = 0_IntKi - END IF + ! positionXY = (/pos1(1),pos1(2)/) + ! m%WaveElev1(j) = SeaSt_Interp_3D( Time, positionXY, p%WaveElev1, p%seast_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! IF (associated(p%WaveElev2)) THEN + ! m%WaveElev2(j) = SeaSt_Interp_3D( Time, positionXY, p%WaveElev2, p%seast_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%WaveElev(j) = m%WaveElev1(j) + m%WaveElev2(j) + ! ELSE + ! m%WaveElev(j) = m%WaveElev1(j) + ! END IF - ELSE ! Wave stretching enabled + ! m%WaveElev1(j) = WaveField_GetWaveElev1(p%WaveField, Time, pos1, ErrStat2, ErrMsg2) + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%WaveElev2(j) = WaveField_GetWaveElev2(p%WaveField, Time, pos1, ErrStat2, ErrMsg2) + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%WaveElev( j) = m%WaveElev1(j) + m%WaveElev2(j) - IF ( pos1(3) <= m%WaveElev(j)) THEN ! Node is submerged - - m%nodeInWater(j) = 1_IntKi - - IF (p%WaveStMod <3) THEN ! Vertical or extrapolated wave stretching - - IF ( pos1(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, pos1, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%FV(:,j) = SeaSt_Interp_4D_Vec( p%WaveVel, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%FA(:,j) = SeaSt_Interp_4D_Vec( p%WaveAcc, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%FDynP(j) = SeaSt_Interp_4D ( p%WaveDynP, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSE ! Node is above SWL - need wave stretching - - ! Vertical wave stretching - m%FV(:,j) = SeaSt_Interp_3D_vec( Time, positionXY, p%WaveVel0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%FA(:,j) = SeaSt_Interp_3D_vec( Time, positionXY, p%WaveAcc0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%FDynP(j) = SeaSt_Interp_3D ( Time, positionXY, p%WaveDynP0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Extrapoled wave stretching - IF (p%WaveStMod == 2) THEN - m%FV(:,j) = m%FV(:,j) + SeaSt_Interp_3D_vec( Time, positionXY, p%PWaveVel0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos1(3) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%FA(:,j) = m%FA(:,j) + SeaSt_Interp_3D_vec( Time, positionXY, p%PWaveAcc0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos1(3) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%FDynP(j) = m%FDynP(j) + SeaSt_Interp_3D ( Time, positionXY, p%PWaveDynP0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos1(3) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - 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 [-WtrDpth,m%WaveElev(j)] to [-WtrDpth,0] - pos1Prime = pos1 - pos1Prime(3) = WtrDpth*(WtrDpth+pos1(3))/(WtrDpth+m%WaveElev(j))-WtrDpth - - ! Obtain the wave-field variables by interpolation with the mapped position. - call SeaSt_Interp_Setup( Time, pos1Prime, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%FV(:,j) = SeaSt_Interp_4D_Vec( p%WaveVel, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%FA(:,j) = SeaSt_Interp_4D_Vec( p%WaveAcc, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%FDynP(j) = SeaSt_Interp_4D ( p%WaveDynP, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF - - m%vrel(:,j) = m%FV(:,j) - u%Mesh%TranslationVel(:,j) - - ELSE ! Node is out of water - zero-out all wave dynamics - - m%nodeInWater(j) = 0_IntKi - m%FV(:,j) = 0.0 - m%FA(:,j) = 0.0 - m%FDynP(j) = 0.0 - m%vrel(:,j) = 0.0 - - END IF ! If node is in or out of water - - END IF ! If wave stretching is on or off + + ! IF (p%WaveStMod == 0) THEN ! No wave stretching + ! + ! IF ( pos1(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL + ! ! Use location to obtain interpolated values of kinematics + ! call SeaSt_Interp_Setup( Time, pos1, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%FV(:,j) = SeaSt_Interp_4D_Vec( p%WaveVel, m%seast_interp_m, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%FA(:,j) = SeaSt_Interp_4D_Vec( p%WaveAcc, m%seast_interp_m, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%FDynP(j) = SeaSt_Interp_4D ( p%WaveDynP, m%seast_interp_m, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%vrel(:,j) = m%FV(:,j) - u%Mesh%TranslationVel(:,j) + ! m%nodeInWater(j) = 1_IntKi + ! ELSE ! Node is above the SWL + ! m%FV(:,j) = 0.0 + ! m%FA(:,j) = 0.0 + ! m%FDynP(j) = 0.0 + ! m%vrel(:,j) = 0.0 + ! m%nodeInWater(j) = 0_IntKi + ! END IF + ! + ! ELSE ! Wave stretching enabled + ! + ! IF ( pos1(3) <= m%WaveElev(j)) THEN ! Node is submerged + ! + ! m%nodeInWater(j) = 1_IntKi + ! + ! IF (p%WaveStMod <3) THEN ! Vertical or extrapolated wave stretching + ! + ! IF ( pos1(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, pos1, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%FV(:,j) = SeaSt_Interp_4D_Vec( p%WaveVel, m%seast_interp_m, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%FA(:,j) = SeaSt_Interp_4D_Vec( p%WaveAcc, m%seast_interp_m, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%FDynP(j) = SeaSt_Interp_4D ( p%WaveDynP, m%seast_interp_m, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! + ! ELSE ! Node is above SWL - need wave stretching + ! + ! ! Vertical wave stretching + ! m%FV(:,j) = SeaSt_Interp_3D_vec( Time, positionXY, p%WaveVel0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%FA(:,j) = SeaSt_Interp_3D_vec( Time, positionXY, p%WaveAcc0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%FDynP(j) = SeaSt_Interp_3D ( Time, positionXY, p%WaveDynP0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! + ! ! Extrapoled wave stretching + ! IF (p%WaveStMod == 2) THEN + ! m%FV(:,j) = m%FV(:,j) + SeaSt_Interp_3D_vec( Time, positionXY, p%PWaveVel0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos1(3) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%FA(:,j) = m%FA(:,j) + SeaSt_Interp_3D_vec( Time, positionXY, p%PWaveAcc0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos1(3) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%FDynP(j) = m%FDynP(j) + SeaSt_Interp_3D ( Time, positionXY, p%PWaveDynP0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos1(3) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! 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 [-WtrDpth,m%WaveElev(j)] to [-WtrDpth,0] + ! pos1Prime = pos1 + ! pos1Prime(3) = WtrDpth*(WtrDpth+pos1(3))/(WtrDpth+m%WaveElev(j))-WtrDpth + ! + ! ! Obtain the wave-field variables by interpolation with the mapped position. + ! call SeaSt_Interp_Setup( Time, pos1Prime, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%FV(:,j) = SeaSt_Interp_4D_Vec( p%WaveVel, m%seast_interp_m, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%FA(:,j) = SeaSt_Interp_4D_Vec( p%WaveAcc, m%seast_interp_m, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%FDynP(j) = SeaSt_Interp_4D ( p%WaveDynP, m%seast_interp_m, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! + ! END IF + ! + ! m%vrel(:,j) = m%FV(:,j) - u%Mesh%TranslationVel(:,j) + ! + ! ELSE ! Node is out of water - zero-out all wave dynamics + ! + ! m%nodeInWater(j) = 0_IntKi + ! m%FV(:,j) = 0.0 + ! m%FA(:,j) = 0.0 + ! m%FDynP(j) = 0.0 + ! m%vrel(:,j) = 0.0 + ! + ! END IF ! If node is in or out of water + ! + ! END IF ! If wave stretching is on or off + + CALL WaveField_GetWaveKin( p%WaveField, Time, pos1, m%nodeInWater(j), m%WaveElev1(j), m%WaveElev2(j), m%WaveElev(j), FDynP, FV, FA, FAMCF, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + m%FDynP(j) = REAL(FDynP,ReKi) + m%FV(:, j) = REAL(FV, ReKi) + m%FA(:, j) = REAL(FA, ReKi) + IF (ALLOCATED(m%FAMCF)) THEN + m%FAMCF(:,j) = REAL(FAMCF,ReKi) + END IF + m%vrel(:,j) = ( m%FV(:,j) - u%Mesh%TranslationVel(:,j) ) * m%nodeInWater(j) END DO ! j = 1, p%NNodes ! Scaled fluid acceleration for the MacCamy-Fuchs model - IF ( ASSOCIATED(p%WaveAccMCF) ) THEN - DO im = 1,p%NMembers - IF ( p%Members(im)%PropMCF .AND. ( .NOT. p%Members(im)%PropPot ) ) THEN - DO i = 1,p%Members(im)%NElements+1 - j = p%Members(im)%NodeIndx(i) - - IF (p%WaveDisp == 0 ) THEN - ! use the initial X,Y location - pos1(1) = u%Mesh%Position(1,j) - pos1(2) = u%Mesh%Position(2,j) - ELSE - ! Use current X,Y location - pos1(1) = u%Mesh%TranslationDisp(1,j) + u%Mesh%Position(1,j) - pos1(2) = u%Mesh%TranslationDisp(2,j) + u%Mesh%Position(2,j) - END IF - - IF (p%WaveStMod > 0 .AND. p%WaveDisp /= 0) THEN ! Wave stretching enabled - pos1(3) = u%Mesh%Position(3,j) + u%Mesh%TranslationDisp(3,j) - p%MSL2SWL ! Use the current Z location. - ELSE ! Wave stretching disabled - pos1(3) = u%Mesh%Position(3,j) - p%MSL2SWL ! We are intentionally using the undisplaced Z position of the node. - END IF - - ! Compute the free surface elevation at the x/y position of all nodes - positionXY = (/pos1(1),pos1(2)/) - - IF (p%WaveStMod == 0) THEN ! No wave stretching - - IF ( pos1(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL - ! Use location to obtain interpolated values of kinematics - call SeaSt_Interp_Setup( Time, pos1, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%FAMCF(:,j) = SeaSt_Interp_4D_Vec( p%WaveAccMCF, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSE ! Node is above the SWL - m%FAMCF(:,j) = 0.0 - END IF - - ELSE ! Wave stretching enabled - - IF ( pos1(3) <= m%WaveElev(j)) THEN ! Node is submerged - - IF (p%WaveStMod <3) THEN ! Vertical or extrapolated wave stretching - - IF ( pos1(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, pos1, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%FAMCF(:,j) = SeaSt_Interp_4D_Vec( p%WaveAccMCF, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSE ! Node is above SWL - need wave stretching - - - ! Vertical wave stretching - m%FAMCF(:,j) = SeaSt_Interp_3D_vec( Time, positionXY, p%WaveAccMCF0, p%seast_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Extrapoled wave stretching - IF (p%WaveStMod == 2) THEN - m%FAMCF(:,j) = m%FAMCF(:,j) + SeaSt_Interp_3D_vec( Time, positionXY, p%PWaveAccMCF0, p%seast_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos1(3) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - 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 [-WtrDpth,m%WaveElev(j)] to [-WtrDpth,0] - pos1Prime = pos1 - pos1Prime(3) = WtrDpth*(WtrDpth+pos1(3))/(WtrDpth+m%WaveElev(j))-WtrDpth - - ! Obtain the wave-field variables by interpolation with the mapped position. - call SeaSt_Interp_Setup( Time, pos1Prime, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%FAMCF(:,j) = SeaSt_Interp_4D_Vec( p%WaveAccMCF, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF - - ELSE ! Node is out of water - zero-out all wave dynamics - - m%FAMCF(:,j) = 0.0 - - END IF ! If node is in or out of water - - END IF ! If wave stretching is on or off - - END DO - END IF - END DO - END IF + ! IF ( ASSOCIATED(p%WaveAccMCF) ) THEN + ! DO im = 1,p%NMembers + ! IF ( p%Members(im)%PropMCF .AND. ( .NOT. p%Members(im)%PropPot ) ) THEN + ! DO i = 1,p%Members(im)%NElements+1 + ! j = p%Members(im)%NodeIndx(i) + ! + ! IF (p%WaveDisp == 0 ) THEN + ! ! use the initial X,Y location + ! pos1(1) = u%Mesh%Position(1,j) + ! pos1(2) = u%Mesh%Position(2,j) + ! ELSE + ! ! Use current X,Y location + ! pos1(1) = u%Mesh%TranslationDisp(1,j) + u%Mesh%Position(1,j) + ! pos1(2) = u%Mesh%TranslationDisp(2,j) + u%Mesh%Position(2,j) + ! END IF + ! + ! IF (p%WaveStMod > 0 .AND. p%WaveDisp /= 0) THEN ! Wave stretching enabled + ! pos1(3) = u%Mesh%Position(3,j) + u%Mesh%TranslationDisp(3,j) - p%MSL2SWL ! Use the current Z location. + ! ELSE ! Wave stretching disabled + ! pos1(3) = u%Mesh%Position(3,j) - p%MSL2SWL ! We are intentionally using the undisplaced Z position of the node. + ! END IF + ! + ! ! Compute the free surface elevation at the x/y position of all nodes + ! positionXY = (/pos1(1),pos1(2)/) + ! + ! IF (p%WaveStMod == 0) THEN ! No wave stretching + ! + ! IF ( pos1(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL + ! ! Use location to obtain interpolated values of kinematics + ! call SeaSt_Interp_Setup( Time, pos1, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%FAMCF(:,j) = SeaSt_Interp_4D_Vec( p%WaveAccMCF, m%seast_interp_m, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! ELSE ! Node is above the SWL + ! m%FAMCF(:,j) = 0.0 + ! END IF + ! + ! ELSE ! Wave stretching enabled + ! + ! IF ( pos1(3) <= m%WaveElev(j)) THEN ! Node is submerged + ! + ! IF (p%WaveStMod <3) THEN ! Vertical or extrapolated wave stretching + ! + ! IF ( pos1(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, pos1, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%FAMCF(:,j) = SeaSt_Interp_4D_Vec( p%WaveAccMCF, m%seast_interp_m, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! ELSE ! Node is above SWL - need wave stretching + ! + ! + ! ! Vertical wave stretching + ! m%FAMCF(:,j) = SeaSt_Interp_3D_vec( Time, positionXY, p%WaveAccMCF0, p%seast_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! + ! ! Extrapoled wave stretching + ! IF (p%WaveStMod == 2) THEN + ! m%FAMCF(:,j) = m%FAMCF(:,j) + SeaSt_Interp_3D_vec( Time, positionXY, p%PWaveAccMCF0, p%seast_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos1(3) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! 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 [-WtrDpth,m%WaveElev(j)] to [-WtrDpth,0] + ! pos1Prime = pos1 + ! pos1Prime(3) = WtrDpth*(WtrDpth+pos1(3))/(WtrDpth+m%WaveElev(j))-WtrDpth + ! + ! ! Obtain the wave-field variables by interpolation with the mapped position. + ! call SeaSt_Interp_Setup( Time, pos1Prime, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! m%FAMCF(:,j) = SeaSt_Interp_4D_Vec( p%WaveAccMCF, m%seast_interp_m, ErrStat2, ErrMsg2 ) + ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! + ! END IF + ! + ! ELSE ! Node is out of water - zero-out all wave dynamics + ! + ! m%FAMCF(:,j) = 0.0 + ! + ! END IF ! If node is in or out of water + ! + ! END IF ! If wave stretching is on or off + ! + ! END DO + ! END IF + ! END DO + ! END IF ! ============================================================================================== ! Calculate instantaneous loads on each member except for the hydrodynamic loads on member ends. diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index c497c62747..01d0584aa0 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -14,6 +14,7 @@ # 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 # # typedef Morison/Morison Morison_JointType INTEGER JointID - - - "User-specified integer ID for the given joint" - @@ -286,6 +287,7 @@ typedef ^ ^ SiKi typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - typedef ^ ^ INTEGER WaveStMod - - - "" - typedef ^ ^ SiKi MCFD - - - "Diameter of the MacCamy-Fuchs member." - +typedef ^ ^ SeaSt_WaveFieldType WaveField - - - "SeaState wave field" - # # # Define outputs from the initialization routine here: @@ -395,6 +397,7 @@ typedef ^ ^ OutParmType typedef ^ ^ INTEGER NumOuts - - - "" - typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - typedef ^ ^ INTEGER WaveStMod - - - "" - +typedef ^ ^ SeaSt_WaveFieldType WaveField - - - "SeaState wave field" - # # # ..... Inputs .................................................................................................................... diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index e8efa36e3e..35ee937376 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -31,7 +31,7 @@ !! 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 ! ========= Morison_JointType ======= @@ -349,6 +349,7 @@ MODULE Morison_Types TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] INTEGER(IntKi) :: WaveStMod !< [-] REAL(SiKi) :: MCFD !< Diameter of the MacCamy-Fuchs member. [-] + TYPE(SeaSt_WaveFieldType) :: WaveField !< SeaState wave field [-] END TYPE Morison_InitInputType ! ======================= ! ========= Morison_InitOutputType ======= @@ -448,6 +449,7 @@ MODULE Morison_Types INTEGER(IntKi) :: NumOuts !< [-] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] INTEGER(IntKi) :: WaveStMod !< [-] + TYPE(SeaSt_WaveFieldType) :: WaveField !< SeaState wave field [-] END TYPE Morison_ParameterType ! ======================= ! ========= Morison_InputType ======= @@ -6783,6 +6785,9 @@ SUBROUTINE Morison_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod DstInitInputData%MCFD = SrcInitInputData%MCFD + CALL SeaSt_WaveField_Copyseast_wavefieldtype( SrcInitInputData%WaveField, DstInitInputData%WaveField, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE Morison_CopyInitInput SUBROUTINE Morison_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) @@ -6943,6 +6948,8 @@ SUBROUTINE Morison_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEp ENDIF CALL SeaSt_Interp_DestroyParam( InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL SeaSt_WaveField_Destroyseast_wavefieldtype( InitInputData%WaveField, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Morison_DestroyInitInput SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -7350,6 +7357,23 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END IF Int_BufSz = Int_BufSz + 1 ! WaveStMod Re_BufSz = Re_BufSz + 1 ! MCFD + Int_BufSz = Int_BufSz + 3 ! WaveField: size of buffers for each call to pack subtype + CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! WaveField + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! WaveField + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! WaveField + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -8266,6 +8290,34 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 1 ReKiBuf(Re_Xferred) = InData%MCFD Re_Xferred = Re_Xferred + 1 + CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END SUBROUTINE Morison_PackInitInput SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -9401,6 +9453,46 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Xferred = Int_Xferred + 1 OutData%MCFD = REAL(ReKiBuf(Re_Xferred), SiKi) Re_Xferred = Re_Xferred + 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SeaSt_WaveField_Unpackseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE Morison_UnPackInitInput SUBROUTINE Morison_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -12140,6 +12232,9 @@ SUBROUTINE Morison_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Err CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN DstParamData%WaveStMod = SrcParamData%WaveStMod + CALL SeaSt_WaveField_Copyseast_wavefieldtype( SrcParamData%WaveField, DstParamData%WaveField, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE Morison_CopyParam SUBROUTINE Morison_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) @@ -12290,6 +12385,8 @@ SUBROUTINE Morison_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ENDIF CALL SeaSt_Interp_DestroyParam( ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL SeaSt_WaveField_Destroyseast_wavefieldtype( ParamData%WaveField, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Morison_DestroyParam SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -12577,6 +12674,23 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 1 ! WaveStMod + Int_BufSz = Int_BufSz + 3 ! WaveField: size of buffers for each call to pack subtype + CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! WaveField + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! WaveField + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! WaveField + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -13441,6 +13555,34 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ENDIF IntKiBuf(Int_Xferred) = InData%WaveStMod Int_Xferred = Int_Xferred + 1 + CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END SUBROUTINE Morison_PackParam SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -14458,6 +14600,46 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) OutData%WaveStMod = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SeaSt_WaveField_Unpackseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE Morison_UnPackParam SUBROUTINE Morison_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 0e0585a17f..d91a3cfb14 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -844,6 +844,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, call SeaSt_Interp_CopyParam(Init%OutData_SeaSt%SeaSt_Interp_p, Init%InData_HD%SeaSt_Interp_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + call SeaSt_WaveField_CopySeaSt_WaveFieldType( Init%OutData_SeaSt%WaveField, Init%InData_HD%WaveField, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index f2d96b204f..6d2f60f26e 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -135,10 +135,10 @@ SUBROUTINE WaveField_GetWaveNormal( WaveField, Time, pos, r, n, ErrStat, ErrMsg END SUBROUTINE WaveField_GetWaveNormal !-------------------- Subroutine for full wave field kinematics --------------------! -SUBROUTINE WaveField_GetWaveKin( WaveField, Time, pos, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) +SUBROUTINE WaveField_GetWaveKin( WaveField, Time, posIn, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField REAL(DbKi), INTENT( IN ) :: Time - REAL(ReKi), INTENT( IN ) :: pos(3) + REAL(ReKi), INTENT( IN ) :: posIn(3) REAL(SiKi), INTENT( OUT ) :: WaveElev1 REAL(SiKi), INTENT( OUT ) :: WaveElev2 REAL(SiKi), INTENT( OUT ) :: WaveElev @@ -151,7 +151,7 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, Time, pos, nodeInWater, WaveElev1, W 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) + REAL(ReKi) :: pos(3), posXY(2), posPrime(3), posXY0(3) TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m LOGICAL :: FirstWarn_Clamp CHARACTER(*), PARAMETER :: RoutineName = 'GetWaveKin' @@ -161,8 +161,9 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, Time, pos, nodeInWater, WaveElev1, W ErrStat = ErrID_None ErrMsg = "" - posXY = pos(1:2) - posXY0 = (/pos(1),pos(2),0.0_ReKi/) + pos = (/posIn(1),posIn(2),posIn(3)-WaveField%MSL2SWL/) ! Vertical position measured from the SWL + posXY = posIn(1:2) + posXY0 = (/posIn(1),posIn(2),0.0_ReKi/) FAMCF(:) = 0.0 ! Wave elevation @@ -255,9 +256,9 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, Time, pos, nodeInWater, WaveElev1, W ELSE ! Wheeler stretching - no need to check whether the node is above or below SWL - ! Map the node z-position linearly from [-WtrDpth,m%WaveElev(j)] to [-WtrDpth,0] + ! Map the node z-position linearly from [-EffWtrDpth,m%WaveElev(j)] to [-EffWtrDpth,0] posPrime = pos - posPrime(3) = WaveField%WtrDpth*(WaveField%WtrDpth+pos(3))/(WaveField%WtrDpth+WaveElev)-WaveField%WtrDpth + posPrime(3) = WaveField%EffWtrDpth*(WaveField%EffWtrDpth+pos(3))/(WaveField%EffWtrDpth+WaveElev)-WaveField%EffWtrDpth ! 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 ) diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index 0ae7593c33..00f49a4f04 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -18,4 +18,5 @@ typedef ^ ^ SiKi typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation" (m) typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "Parameter information from the SeaState Interpolation module" (-) typedef ^ ^ IntKi WaveStMod - - - "Wave stretching model" -typedef ^ ^ ReKi WtrDpth - - - "Water depth" (-) +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 a46f4bc33e..221053f234 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -49,7 +49,8 @@ MODULE SeaSt_WaveField_Types REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation [(m)] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< Parameter information from the SeaState Interpolation module [(-)] INTEGER(IntKi) :: WaveStMod !< Wave stretching model [-] - REAL(ReKi) :: WtrDpth !< Water depth [(-)] + REAL(ReKi) :: EffWtrDpth !< Water depth [(-)] + REAL(ReKi) :: MSL2SWL !< Vertical distance from mean sea level to still water level [(m)] END TYPE SeaSt_WaveFieldType ! ======================= CONTAINS @@ -268,7 +269,8 @@ SUBROUTINE SeaSt_WaveField_CopySeaSt_WaveFieldType( SrcSeaSt_WaveFieldTypeData, CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN DstSeaSt_WaveFieldTypeData%WaveStMod = SrcSeaSt_WaveFieldTypeData%WaveStMod - DstSeaSt_WaveFieldTypeData%WtrDpth = SrcSeaSt_WaveFieldTypeData%WtrDpth + DstSeaSt_WaveFieldTypeData%EffWtrDpth = SrcSeaSt_WaveFieldTypeData%EffWtrDpth + DstSeaSt_WaveFieldTypeData%MSL2SWL = SrcSeaSt_WaveFieldTypeData%MSL2SWL END SUBROUTINE SeaSt_WaveField_CopySeaSt_WaveFieldType SUBROUTINE SeaSt_WaveField_DestroySeaSt_WaveFieldType( SeaSt_WaveFieldTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) @@ -460,7 +462,8 @@ SUBROUTINE SeaSt_WaveField_PackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 1 ! WaveStMod - Re_BufSz = Re_BufSz + 1 ! WtrDpth + Re_BufSz = Re_BufSz + 1 ! EffWtrDpth + Re_BufSz = Re_BufSz + 1 ! MSL2SWL IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -833,7 +836,9 @@ SUBROUTINE SeaSt_WaveField_PackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf, ENDIF IntKiBuf(Int_Xferred) = InData%WaveStMod Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth + ReKiBuf(Re_Xferred) = InData%EffWtrDpth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MSL2SWL Re_Xferred = Re_Xferred + 1 END SUBROUTINE SeaSt_WaveField_PackSeaSt_WaveFieldType @@ -1258,7 +1263,9 @@ SUBROUTINE SeaSt_WaveField_UnPackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) OutData%WaveStMod = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) + OutData%EffWtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MSL2SWL = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END SUBROUTINE SeaSt_WaveField_UnPackSeaSt_WaveFieldType diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 2eeaaa54f9..4ac799d71c 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -21,7 +21,7 @@ ! 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. -! rning generating S +! !********************************************************************************************************************************** MODULE SeaState @@ -233,29 +233,14 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WaveElevC0 => Waves_InitOut%WaveElevC0 p%WaveDirArr => Waves_InitOut%WaveDirArr p%PWaveAccMCF0 => Waves_InitOut%PWaveAccMCF0 - - p%WaveField%WtrDpth = p%WtrDpth - p%WaveField%WaveStMod = p%WaveStMod - p%WaveField%WaveTime => Waves_InitOut%WaveTime - 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 - p%WaveField%WaveAccMCF => Waves_InitOut%WaveAccMCF - p%WaveField%PWaveAccMCF0 => Waves_InitOut%PWaveAccMCF0 - - ! check error (must be done AFTER moving pointers to parameters) + + ! check error (must be done AFTER moving pointers to parameters) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() RETURN END IF - - - - ! Copy Waves initialization output into the initialization input type for the WAMIT module + + ! Copy Waves initialization output into the initialization input type for the WAMIT module p%NStepWave = Waves_InitOut%NStepWave p%WaveDT = InputFileData%Waves%WaveDT @@ -516,7 +501,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init 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%seast_interp_p, ErrStat2, ErrMsg2) - CALL SeaSt_Interp_CopyParam( p%seast_interp_p, p%WaveField%seast_interp_p, 0, ErrStat2, ErrMsg2 ) + CALL SeaSt_Interp_CopyParam( p%seast_interp_p, p%WaveField%seast_interp_p, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) 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! @@ -566,6 +551,23 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%SeaSt_Interp_p = p%seast_interp_p + ! Build WaveField + p%WaveField%MSL2SWL = InitOut%MSL2SWL + p%WaveField%EffWtrDpth = p%WtrDpth + InitOut%MSL2SWL ! Effective water depth measured from the SWL + p%WaveField%WaveStMod = p%WaveStMod + p%WaveField%WaveTime => Waves_InitOut%WaveTime + 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 + p%WaveField%WaveAccMCF => Waves_InitOut%WaveAccMCF + p%WaveField%PWaveAccMCF0 => Waves_InitOut%PWaveAccMCF0 + + CALL SeaSt_WaveField_CopySeaSt_WaveFieldType( p%WaveField, InitOut%WaveField, MESH_NEWCOPY, ErrStat2, ErrMsg2) + ! Tell HydroDyn if state-space wave excitation is not allowed: InitOut%InvalidWithSSExctn = InputFileData%Waves%WaveMod == 6 .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%Waves%WaveDirMod /= 0 .or. & !call SetErrStat( ErrID_Fatal, 'Directional spreading cannot be used with state-space wave excitations. Set WaveDirMod=0.', ErrStat, ErrMsg, RoutineName ) diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 5c957585d7..cea3c6c7e8 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -111,6 +111,7 @@ typedef ^ ^ LOGICAL InvalidWith typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - typedef ^ ^ SiKi MCFD - - - "Diameter of MacCamy-Fuchs member" (meters) typedef ^ ^ SiKi WaveElevSeries {:}{:} - - "Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second dimension is XY point number corresponding to second dimension of WaveElevXY." (m) +typedef ^ ^ SeaSt_WaveFieldType WaveField - - - "Wave field" # # # ..... States .................................................................................................................... diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index c0756af2df..420e3ee20b 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -131,6 +131,7 @@ MODULE SeaState_Types TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] REAL(SiKi) :: MCFD !< Diameter of MacCamy-Fuchs member [(meters)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevSeries !< Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second dimension is XY point number corresponding to second dimension of WaveElevXY. [(m)] + TYPE(SeaSt_WaveFieldType) :: WaveField !< Wave field [-] END TYPE SeaSt_InitOutputType ! ======================= ! ========= SeaSt_ContinuousStateType ======= @@ -1776,6 +1777,9 @@ SUBROUTINE SeaSt_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, END IF DstInitOutputData%WaveElevSeries = SrcInitOutputData%WaveElevSeries ENDIF + CALL SeaSt_WaveField_Copyseast_wavefieldtype( SrcInitOutputData%WaveField, DstInitOutputData%WaveField, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE SeaSt_CopyInitOutput SUBROUTINE SeaSt_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) @@ -1883,6 +1887,8 @@ SUBROUTINE SeaSt_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEp IF (ALLOCATED(InitOutputData%WaveElevSeries)) THEN DEALLOCATE(InitOutputData%WaveElevSeries) ENDIF + CALL SeaSt_WaveField_Destroyseast_wavefieldtype( InitOutputData%WaveField, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SeaSt_DestroyInitOutput SUBROUTINE SeaSt_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2067,6 +2073,23 @@ SUBROUTINE SeaSt_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_BufSz = Int_BufSz + 2*2 ! WaveElevSeries upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveElevSeries) ! WaveElevSeries END IF + Int_BufSz = Int_BufSz + 3 ! WaveField: size of buffers for each call to pack subtype + CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! WaveField + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! WaveField + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! WaveField + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -2638,6 +2661,34 @@ SUBROUTINE SeaSt_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END DO END DO END IF + CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END SUBROUTINE SeaSt_PackInitOutput SUBROUTINE SeaSt_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3293,6 +3344,46 @@ SUBROUTINE SeaSt_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, END DO END DO END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SeaSt_WaveField_Unpackseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE SeaSt_UnPackInitOutput SUBROUTINE SeaSt_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) From dabf1e38be5fdc6aa81cfb183762089948644e64 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 24 May 2023 20:51:36 +0000 Subject: [PATCH 03/12] Port openfast-registry to C++ and change pointers --- .../fast-farm/src/FASTWrapper_Types.f90 | 132 +- glue-codes/fast-farm/src/FAST_Farm_Types.f90 | 240 +- modules/aerodyn/src/AeroAcoustics_Types.f90 | 158 +- modules/aerodyn/src/AeroDyn_Driver_Types.f90 | 243 +- modules/aerodyn/src/AeroDyn_Inflow_Types.f90 | 308 +- modules/aerodyn/src/AeroDyn_Registry.txt | 2 +- modules/aerodyn/src/AeroDyn_Types.f90 | 546 +-- modules/aerodyn/src/AirfoilInfo_Types.f90 | 112 +- modules/aerodyn/src/BEMT_Types.f90 | 157 +- modules/aerodyn/src/DBEMT_Types.f90 | 150 +- modules/aerodyn/src/FVW_Types.f90 | 329 +- modules/aerodyn/src/UnsteadyAero_Types.f90 | 138 +- modules/aerodyn14/src/AeroDyn14_Types.f90 | 556 +-- modules/aerodyn14/src/DWM_Types.f90 | 344 +- modules/aerodyn14/src/Registry-AD14.txt | 37 +- modules/awae/src/AWAE_Types.f90 | 172 +- modules/beamdyn/src/BeamDyn_Types.f90 | 228 +- modules/elastodyn/src/ElastoDyn_Types.f90 | 240 +- modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 132 +- modules/feamooring/src/FEAMooring_Types.f90 | 128 +- modules/hydrodyn/src/Conv_Radiation_Types.f90 | 100 +- modules/hydrodyn/src/Current_Types.f90 | 1946 +++++++++ modules/hydrodyn/src/HydroDyn.f90 | 20 +- modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 16 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 1795 ++------ modules/hydrodyn/src/Morison_Types.f90 | 2913 ++----------- modules/hydrodyn/src/SS_Excitation.f90 | 16 +- modules/hydrodyn/src/SS_Excitation_Types.f90 | 388 +- modules/hydrodyn/src/SS_Radiation_Types.f90 | 104 +- modules/hydrodyn/src/WAMIT.f90 | 14 +- modules/hydrodyn/src/WAMIT2_Types.f90 | 168 +- modules/hydrodyn/src/WAMIT_Types.f90 | 417 +- modules/hydrodyn/src/Waves2_Types.f90 | 3841 +++++++++++++++++ modules/hydrodyn/src/Waves_Types.f90 | 3586 +++++++++++++++ modules/icedyn/src/IceDyn_Types.f90 | 120 +- modules/icefloe/src/icefloe/IceFloe_Types.f90 | 112 +- .../inflowwind/src/IfW_FlowField_Types.f90 | 118 +- modules/inflowwind/src/InflowWind.f90 | 2 +- .../inflowwind/src/InflowWind_IO_Types.f90 | 126 +- modules/inflowwind/src/InflowWind_Types.f90 | 193 +- modules/inflowwind/src/Lidar_Types.f90 | 110 +- modules/map/src/MAP_Fortran_Types.f90 | 34 +- modules/map/src/MAP_Types.f90 | 797 ++-- modules/moordyn/src/MoorDyn_Types.f90 | 290 +- modules/openfast-library/src/FAST_Subs.f90 | 2 +- modules/openfast-library/src/FAST_Types.f90 | 1462 +++---- modules/openfast-registry/CMakeLists.txt | 24 +- modules/openfast-registry/src/FAST_preamble.h | 45 - modules/openfast-registry/src/Template_data.c | 849 ---- .../openfast-registry/src/Template_registry.c | 81 - modules/openfast-registry/src/data.c | 229 - modules/openfast-registry/src/data.h | 134 - modules/openfast-registry/src/gen_c_types.c | 428 -- .../openfast-registry/src/gen_module_files.c | 2521 ----------- modules/openfast-registry/src/main.cpp | 183 + modules/openfast-registry/src/misc.c | 710 --- modules/openfast-registry/src/my_strtok.c | 139 - modules/openfast-registry/src/protos.h | 189 - modules/openfast-registry/src/reg_parse.c | 814 ---- modules/openfast-registry/src/registry.c | 311 -- modules/openfast-registry/src/registry.cpp | 36 + modules/openfast-registry/src/registry.h | 63 - modules/openfast-registry/src/registry.hpp | 541 +++ .../openfast-registry/src/registry_gen_c.cpp | 116 + .../src/registry_gen_fortran.cpp | 1832 ++++++++ .../openfast-registry/src/registry_parse.cpp | 293 ++ modules/openfast-registry/src/sym.c | 163 - modules/openfast-registry/src/sym.h | 97 - modules/openfast-registry/src/symtab_gen.c | 208 - modules/openfast-registry/src/templates.hpp | 973 +++++ modules/openfast-registry/src/type.c | 428 -- modules/openfoam/src/OpenFOAM_Types.f90 | 661 ++- .../src/OrcaFlexInterface_Types.f90 | 130 +- modules/seastate/src/Current_Types.f90 | 20 +- .../seastate/src/SeaSt_WaveField_Types.f90 | 1010 +---- modules/seastate/src/SeaState.f90 | 6 +- modules/seastate/src/SeaState_DriverCode.f90 | 6 +- .../seastate/src/SeaState_Interp_Types.f90 | 48 +- modules/seastate/src/SeaState_Types.f90 | 2859 ++---------- modules/seastate/src/Waves2_Types.f90 | 304 +- modules/seastate/src/Waves_Types.f90 | 1080 +---- modules/servodyn/src/ServoDyn_Types.f90 | 306 +- modules/servodyn/src/StrucCtrl_Types.f90 | 138 +- modules/subdyn/src/SubDyn_Types.f90 | 224 +- .../supercontroller/src/SCDataEx_Types.f90 | 133 +- .../src/SuperController_Types.f90 | 303 +- .../wakedynamics/src/WakeDynamics_Types.f90 | 132 +- vs-build/Registry/FAST_Registry.vcxproj | 22 +- 88 files changed, 17518 insertions(+), 24313 deletions(-) create mode 100644 modules/hydrodyn/src/Current_Types.f90 create mode 100644 modules/hydrodyn/src/Waves2_Types.f90 create mode 100644 modules/hydrodyn/src/Waves_Types.f90 delete mode 100644 modules/openfast-registry/src/FAST_preamble.h delete mode 100644 modules/openfast-registry/src/Template_data.c delete mode 100644 modules/openfast-registry/src/Template_registry.c delete mode 100644 modules/openfast-registry/src/data.c delete mode 100644 modules/openfast-registry/src/data.h delete mode 100644 modules/openfast-registry/src/gen_c_types.c delete mode 100644 modules/openfast-registry/src/gen_module_files.c create mode 100644 modules/openfast-registry/src/main.cpp delete mode 100644 modules/openfast-registry/src/misc.c delete mode 100644 modules/openfast-registry/src/my_strtok.c delete mode 100644 modules/openfast-registry/src/protos.h delete mode 100644 modules/openfast-registry/src/reg_parse.c delete mode 100644 modules/openfast-registry/src/registry.c create mode 100644 modules/openfast-registry/src/registry.cpp delete mode 100644 modules/openfast-registry/src/registry.h create mode 100644 modules/openfast-registry/src/registry.hpp create mode 100644 modules/openfast-registry/src/registry_gen_c.cpp create mode 100644 modules/openfast-registry/src/registry_gen_fortran.cpp create mode 100644 modules/openfast-registry/src/registry_parse.cpp delete mode 100644 modules/openfast-registry/src/sym.c delete mode 100644 modules/openfast-registry/src/sym.h delete mode 100644 modules/openfast-registry/src/symtab_gen.c create mode 100644 modules/openfast-registry/src/templates.hpp delete mode 100644 modules/openfast-registry/src/type.c diff --git a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 index 8c003fc954..94b8cbcc0e 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 @@ -135,10 +135,6 @@ SUBROUTINE FWrap_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_CopyInitInput' @@ -192,14 +188,12 @@ SUBROUTINE FWrap_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er ENDIF END SUBROUTINE FWrap_CopyInitInput - SUBROUTINE FWrap_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FWrap_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(FWrap_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyInitInput' @@ -207,12 +201,6 @@ SUBROUTINE FWrap_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%fromSCGlob)) THEN DEALLOCATE(InitInputData%fromSCGlob) ENDIF @@ -410,10 +398,6 @@ SUBROUTINE FWrap_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_UnPackInitInput' @@ -540,14 +524,12 @@ SUBROUTINE FWrap_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE FWrap_CopyInitOutput - SUBROUTINE FWrap_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FWrap_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(FWrap_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyInitOutput' @@ -555,13 +537,7 @@ SUBROUTINE FWrap_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE FWrap_DestroyInitOutput @@ -603,7 +579,7 @@ SUBROUTINE FWrap_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_BufSz = Db_BufSz + SIZE(InData%PtfmInit) ! PtfmInit ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -650,7 +626,7 @@ SUBROUTINE FWrap_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DbKiBuf(Db_Xferred) = InData%PtfmInit(i1) Db_Xferred = Db_Xferred + 1 END DO - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -746,7 +722,7 @@ SUBROUTINE FWrap_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -772,14 +748,12 @@ SUBROUTINE FWrap_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Er DstContStateData%dummy = SrcContStateData%dummy END SUBROUTINE FWrap_CopyContState - SUBROUTINE FWrap_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FWrap_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(FWrap_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyContState' @@ -787,12 +761,6 @@ SUBROUTINE FWrap_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE FWrap_DestroyContState SUBROUTINE FWrap_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -909,14 +877,12 @@ SUBROUTINE FWrap_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Er DstDiscStateData%dummy = SrcDiscStateData%dummy END SUBROUTINE FWrap_CopyDiscState - SUBROUTINE FWrap_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FWrap_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(FWrap_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyDiscState' @@ -924,12 +890,6 @@ SUBROUTINE FWrap_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE FWrap_DestroyDiscState SUBROUTINE FWrap_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1046,14 +1006,12 @@ SUBROUTINE FWrap_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCo DstConstrStateData%dummy = SrcConstrStateData%dummy END SUBROUTINE FWrap_CopyConstrState - SUBROUTINE FWrap_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FWrap_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(FWrap_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyConstrState' @@ -1061,12 +1019,6 @@ SUBROUTINE FWrap_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCAT ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE FWrap_DestroyConstrState SUBROUTINE FWrap_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1183,14 +1135,12 @@ SUBROUTINE FWrap_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, DstOtherStateData%dummy = SrcOtherStateData%dummy END SUBROUTINE FWrap_CopyOtherState - SUBROUTINE FWrap_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FWrap_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(FWrap_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyOtherState' @@ -1198,12 +1148,6 @@ SUBROUTINE FWrap_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE FWrap_DestroyOtherState SUBROUTINE FWrap_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1387,14 +1331,12 @@ SUBROUTINE FWrap_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FWrap_CopyMisc - SUBROUTINE FWrap_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FWrap_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(FWrap_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyMisc' @@ -1402,13 +1344,7 @@ SUBROUTINE FWrap_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL FAST_Destroyturbinetype( MiscData%Turbine, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyTurbineType( MiscData%Turbine, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MiscData%TempDisp)) THEN DO i1 = LBOUND(MiscData%TempDisp,1), UBOUND(MiscData%TempDisp,1) @@ -1433,7 +1369,7 @@ SUBROUTINE FWrap_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(MiscData%AD_L2L)) THEN DO i1 = LBOUND(MiscData%AD_L2L,1), UBOUND(MiscData%AD_L2L,1) - CALL NWTC_Library_Destroymeshmaptype( MiscData%AD_L2L(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( MiscData%AD_L2L(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%AD_L2L) @@ -1477,7 +1413,7 @@ SUBROUTINE FWrap_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Turbine: size of buffers for each call to pack subtype - CALL FAST_Packturbinetype( Re_Buf, Db_Buf, Int_Buf, InData%Turbine, ErrStat2, ErrMsg2, .TRUE. ) ! Turbine + CALL FAST_PackTurbineType( Re_Buf, Db_Buf, Int_Buf, InData%Turbine, ErrStat2, ErrMsg2, .TRUE. ) ! Turbine CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1567,7 +1503,7 @@ SUBROUTINE FWrap_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 2*1 ! AD_L2L upper/lower bounds for each dimension DO i1 = LBOUND(InData%AD_L2L,1), UBOUND(InData%AD_L2L,1) Int_BufSz = Int_BufSz + 3 ! AD_L2L: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L2L(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AD_L2L + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_L2L(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AD_L2L CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1612,7 +1548,7 @@ SUBROUTINE FWrap_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - CALL FAST_Packturbinetype( Re_Buf, Db_Buf, Int_Buf, InData%Turbine, ErrStat2, ErrMsg2, OnlySize ) ! Turbine + CALL FAST_PackTurbineType( Re_Buf, Db_Buf, Int_Buf, InData%Turbine, ErrStat2, ErrMsg2, OnlySize ) ! Turbine CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1774,7 +1710,7 @@ SUBROUTINE FWrap_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%AD_L2L,1), UBOUND(InData%AD_L2L,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L2L(i1), ErrStat2, ErrMsg2, OnlySize ) ! AD_L2L + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_L2L(i1), ErrStat2, ErrMsg2, OnlySize ) ! AD_L2L CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1866,7 +1802,7 @@ SUBROUTINE FWrap_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackturbinetype( Re_Buf, Db_Buf, Int_Buf, OutData%Turbine, ErrStat2, ErrMsg2 ) ! Turbine + CALL FAST_UnpackTurbineType( Re_Buf, Db_Buf, Int_Buf, OutData%Turbine, ErrStat2, ErrMsg2 ) ! Turbine CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2088,7 +2024,7 @@ SUBROUTINE FWrap_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L2L(i1), ErrStat2, ErrMsg2 ) ! AD_L2L + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L2L(i1), ErrStat2, ErrMsg2 ) ! AD_L2L CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2131,14 +2067,12 @@ SUBROUTINE FWrap_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%p_ref_Turbine = SrcParamData%p_ref_Turbine END SUBROUTINE FWrap_CopyParam - SUBROUTINE FWrap_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FWrap_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(FWrap_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyParam' @@ -2146,12 +2080,6 @@ SUBROUTINE FWrap_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%r)) THEN DEALLOCATE(ParamData%r) ENDIF @@ -2374,14 +2302,12 @@ SUBROUTINE FWrap_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs ENDIF END SUBROUTINE FWrap_CopyInput - SUBROUTINE FWrap_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FWrap_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(FWrap_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyInput' @@ -2389,12 +2315,6 @@ SUBROUTINE FWrap_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputData%fromSCglob)) THEN DEALLOCATE(InputData%fromSCglob) ENDIF @@ -2717,14 +2637,12 @@ SUBROUTINE FWrap_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er ENDIF END SUBROUTINE FWrap_CopyOutput - SUBROUTINE FWrap_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FWrap_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(FWrap_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyOutput' @@ -2732,12 +2650,6 @@ SUBROUTINE FWrap_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%toSC)) THEN DEALLOCATE(OutputData%toSC) ENDIF diff --git a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 index 540dc80c53..51203da76d 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 @@ -87,7 +87,7 @@ MODULE FAST_Farm_Types INTEGER(IntKi) :: NumOuts !< Number of user-requested outputs [-] INTEGER(IntKi) :: NOutSteps !< Maximum number of output steps [-] CHARACTER(1024) , DIMENSION(1:3) :: FileDescLines !< File Description lines [-] - TYPE(ProgDesc) , DIMENSION(NumModules) :: Module_Ver !< Version information from all modules [-] + TYPE(ProgDesc) , DIMENSION(1:NumModules) :: Module_Ver !< Version information from all modules [-] INTEGER(IntKi) :: UnOu !< File unit for Fast.Farm output data [-] REAL(ReKi) :: dX_low !< The spacing of the low-resolution nodes in X direction [m] REAL(ReKi) :: dY_low !< The spacing of the low-resolution nodes in Y direction [m] @@ -358,14 +358,12 @@ SUBROUTINE Farm_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%Z0_low = SrcParamData%Z0_low END SUBROUTINE Farm_CopyParam - SUBROUTINE Farm_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Farm_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(Farm_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyParam' @@ -373,12 +371,6 @@ SUBROUTINE Farm_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%WT_Position)) THEN DEALLOCATE(ParamData%WT_Position) ENDIF @@ -402,13 +394,13 @@ SUBROUTINE Farm_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) ENDIF DO i1 = LBOUND(ParamData%Module_Ver,1), UBOUND(ParamData%Module_Ver,1) - CALL NWTC_Library_Destroyprogdesc( ParamData%Module_Ver(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( ParamData%Module_Ver(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO END SUBROUTINE Farm_DestroyParam @@ -519,7 +511,7 @@ SUBROUTINE Farm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -542,7 +534,7 @@ SUBROUTINE Farm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + SIZE(InData%FileDescLines)*LEN(InData%FileDescLines) ! FileDescLines DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) Int_BufSz = Int_BufSz + 3 ! Module_Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Module_Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Module_Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -795,7 +787,7 @@ SUBROUTINE Farm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -836,7 +828,7 @@ SUBROUTINE Farm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, END DO ! I END DO DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, OnlySize ) ! Module_Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, OnlySize ) ! Module_Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1171,7 +1163,7 @@ SUBROUTINE Farm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1228,7 +1220,7 @@ SUBROUTINE Farm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Module_Ver(i1), ErrStat2, ErrMsg2 ) ! Module_Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Module_Ver(i1), ErrStat2, ErrMsg2 ) ! Module_Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1347,14 +1339,12 @@ SUBROUTINE Farm_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Farm_CopyMisc - SUBROUTINE Farm_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Farm_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(Farm_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyMisc' @@ -1362,12 +1352,6 @@ SUBROUTINE Farm_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MiscData%AllOuts)) THEN DEALLOCATE(MiscData%AllOuts) ENDIF @@ -1379,14 +1363,14 @@ SUBROUTINE Farm_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(MiscData%FWrap_2_MD)) THEN DO i1 = LBOUND(MiscData%FWrap_2_MD,1), UBOUND(MiscData%FWrap_2_MD,1) - CALL NWTC_Library_Destroymeshmaptype( MiscData%FWrap_2_MD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( MiscData%FWrap_2_MD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%FWrap_2_MD) ENDIF IF (ALLOCATED(MiscData%MD_2_FWrap)) THEN DO i1 = LBOUND(MiscData%MD_2_FWrap,1), UBOUND(MiscData%MD_2_FWrap,1) - CALL NWTC_Library_Destroymeshmaptype( MiscData%MD_2_FWrap(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( MiscData%MD_2_FWrap(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%MD_2_FWrap) @@ -1450,7 +1434,7 @@ SUBROUTINE Farm_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%FWrap_2_MD,1), UBOUND(InData%FWrap_2_MD,1) Int_BufSz = Int_BufSz + 3 ! FWrap_2_MD: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%FWrap_2_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FWrap_2_MD + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%FWrap_2_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FWrap_2_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1473,7 +1457,7 @@ SUBROUTINE Farm_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_BufSz = Int_BufSz + 2*1 ! MD_2_FWrap upper/lower bounds for each dimension DO i1 = LBOUND(InData%MD_2_FWrap,1), UBOUND(InData%MD_2_FWrap,1) Int_BufSz = Int_BufSz + 3 ! MD_2_FWrap: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MD_2_FWrap(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MD_2_FWrap + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%MD_2_FWrap(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MD_2_FWrap CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1581,7 +1565,7 @@ SUBROUTINE Farm_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%FWrap_2_MD,1), UBOUND(InData%FWrap_2_MD,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%FWrap_2_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! FWrap_2_MD + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%FWrap_2_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! FWrap_2_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1622,7 +1606,7 @@ SUBROUTINE Farm_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%MD_2_FWrap,1), UBOUND(InData%MD_2_FWrap,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MD_2_FWrap(i1), ErrStat2, ErrMsg2, OnlySize ) ! MD_2_FWrap + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%MD_2_FWrap(i1), ErrStat2, ErrMsg2, OnlySize ) ! MD_2_FWrap CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1790,7 +1774,7 @@ SUBROUTINE Farm_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%FWrap_2_MD(i1), ErrStat2, ErrMsg2 ) ! FWrap_2_MD + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%FWrap_2_MD(i1), ErrStat2, ErrMsg2 ) ! FWrap_2_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1846,7 +1830,7 @@ SUBROUTINE Farm_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%MD_2_FWrap(i1), ErrStat2, ErrMsg2 ) ! MD_2_FWrap + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%MD_2_FWrap(i1), ErrStat2, ErrMsg2 ) ! MD_2_FWrap CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1898,14 +1882,12 @@ SUBROUTINE Farm_CopyFASTWrapper_Data( SrcFASTWrapper_DataData, DstFASTWrapper_Da DstFASTWrapper_DataData%IsInitialized = SrcFASTWrapper_DataData%IsInitialized END SUBROUTINE Farm_CopyFASTWrapper_Data - SUBROUTINE Farm_DestroyFASTWrapper_Data( FASTWrapper_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Farm_DestroyFASTWrapper_Data( FASTWrapper_DataData, ErrStat, ErrMsg ) TYPE(FASTWrapper_Data), INTENT(INOUT) :: FASTWrapper_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyFASTWrapper_Data' @@ -1913,27 +1895,21 @@ SUBROUTINE Farm_DestroyFASTWrapper_Data( FASTWrapper_DataData, ErrStat, ErrMsg, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL FWrap_DestroyContState( FASTWrapper_DataData%x, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FWrap_DestroyContState( FASTWrapper_DataData%x, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyDiscState( FASTWrapper_DataData%xd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FWrap_DestroyDiscState( FASTWrapper_DataData%xd, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyConstrState( FASTWrapper_DataData%z, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FWrap_DestroyConstrState( FASTWrapper_DataData%z, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyOtherState( FASTWrapper_DataData%OtherSt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FWrap_DestroyOtherState( FASTWrapper_DataData%OtherSt, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyParam( FASTWrapper_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FWrap_DestroyParam( FASTWrapper_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyInput( FASTWrapper_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FWrap_DestroyInput( FASTWrapper_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyOutput( FASTWrapper_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FWrap_DestroyOutput( FASTWrapper_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyMisc( FASTWrapper_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FWrap_DestroyMisc( FASTWrapper_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Farm_DestroyFASTWrapper_Data @@ -2756,14 +2732,12 @@ SUBROUTINE Farm_CopyWakeDynamics_Data( SrcWakeDynamics_DataData, DstWakeDynamics DstWakeDynamics_DataData%IsInitialized = SrcWakeDynamics_DataData%IsInitialized END SUBROUTINE Farm_CopyWakeDynamics_Data - SUBROUTINE Farm_DestroyWakeDynamics_Data( WakeDynamics_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Farm_DestroyWakeDynamics_Data( WakeDynamics_DataData, ErrStat, ErrMsg ) TYPE(WakeDynamics_Data), INTENT(INOUT) :: WakeDynamics_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyWakeDynamics_Data' @@ -2771,27 +2745,21 @@ SUBROUTINE Farm_DestroyWakeDynamics_Data( WakeDynamics_DataData, ErrStat, ErrMsg ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL WD_DestroyContState( WakeDynamics_DataData%x, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WD_DestroyContState( WakeDynamics_DataData%x, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyDiscState( WakeDynamics_DataData%xd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WD_DestroyDiscState( WakeDynamics_DataData%xd, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyConstrState( WakeDynamics_DataData%z, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WD_DestroyConstrState( WakeDynamics_DataData%z, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyOtherState( WakeDynamics_DataData%OtherSt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WD_DestroyOtherState( WakeDynamics_DataData%OtherSt, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyParam( WakeDynamics_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WD_DestroyParam( WakeDynamics_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyInput( WakeDynamics_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WD_DestroyInput( WakeDynamics_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyOutput( WakeDynamics_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WD_DestroyOutput( WakeDynamics_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyMisc( WakeDynamics_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WD_DestroyMisc( WakeDynamics_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Farm_DestroyWakeDynamics_Data @@ -3614,14 +3582,12 @@ SUBROUTINE Farm_CopyAWAE_Data( SrcAWAE_DataData, DstAWAE_DataData, CtrlCode, Err DstAWAE_DataData%IsInitialized = SrcAWAE_DataData%IsInitialized END SUBROUTINE Farm_CopyAWAE_Data - SUBROUTINE Farm_DestroyAWAE_Data( AWAE_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Farm_DestroyAWAE_Data( AWAE_DataData, ErrStat, ErrMsg ) TYPE(AWAE_Data), INTENT(INOUT) :: AWAE_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyAWAE_Data' @@ -3629,27 +3595,21 @@ SUBROUTINE Farm_DestroyAWAE_Data( AWAE_DataData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AWAE_DestroyContState( AWAE_DataData%x, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AWAE_DestroyContState( AWAE_DataData%x, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyDiscState( AWAE_DataData%xd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AWAE_DestroyDiscState( AWAE_DataData%xd, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyConstrState( AWAE_DataData%z, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AWAE_DestroyConstrState( AWAE_DataData%z, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyOtherState( AWAE_DataData%OtherSt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AWAE_DestroyOtherState( AWAE_DataData%OtherSt, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyParam( AWAE_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AWAE_DestroyParam( AWAE_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyInput( AWAE_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AWAE_DestroyInput( AWAE_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyOutput( AWAE_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AWAE_DestroyOutput( AWAE_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyMisc( AWAE_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AWAE_DestroyMisc( AWAE_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Farm_DestroyAWAE_Data @@ -4474,14 +4434,12 @@ SUBROUTINE Farm_CopySC_Data( SrcSC_DataData, DstSC_DataData, CtrlCode, ErrStat, DstSC_DataData%IsInitialized = SrcSC_DataData%IsInitialized END SUBROUTINE Farm_CopySC_Data - SUBROUTINE Farm_DestroySC_Data( SC_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Farm_DestroySC_Data( SC_DataData, ErrStat, ErrMsg ) TYPE(SC_Data), INTENT(INOUT) :: SC_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroySC_Data' @@ -4489,27 +4447,21 @@ SUBROUTINE Farm_DestroySC_Data( SC_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL SC_DestroyContState( SC_DataData%x, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SC_DestroyContState( SC_DataData%x, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyDiscState( SC_DataData%xd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SC_DestroyDiscState( SC_DataData%xd, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyConstrState( SC_DataData%z, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SC_DestroyConstrState( SC_DataData%z, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyOtherState( SC_DataData%OtherState, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SC_DestroyOtherState( SC_DataData%OtherState, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyParam( SC_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SC_DestroyParam( SC_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyInput( SC_DataData%uInputs, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SC_DestroyInput( SC_DataData%uInputs, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyOutput( SC_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SC_DestroyOutput( SC_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyMisc( SC_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SC_DestroyMisc( SC_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Farm_DestroySC_Data @@ -5373,14 +5325,12 @@ SUBROUTINE Farm_CopyMD_Data( SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, DstMD_DataData%IsInitialized = SrcMD_DataData%IsInitialized END SUBROUTINE Farm_CopyMD_Data - SUBROUTINE Farm_DestroyMD_Data( MD_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Farm_DestroyMD_Data( MD_DataData, ErrStat, ErrMsg ) TYPE(MD_Data), INTENT(INOUT) :: MD_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyMD_Data' @@ -5388,27 +5338,21 @@ SUBROUTINE Farm_DestroyMD_Data( MD_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MD_DestroyContState( MD_DataData%x, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyContState( MD_DataData%x, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyDiscState( MD_DataData%xd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyDiscState( MD_DataData%xd, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyConstrState( MD_DataData%z, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyConstrState( MD_DataData%z, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyOtherState( MD_DataData%OtherSt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyOtherState( MD_DataData%OtherSt, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyParam( MD_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyParam( MD_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyInput( MD_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyInput( MD_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MD_DataData%Input)) THEN DO i1 = LBOUND(MD_DataData%Input,1), UBOUND(MD_DataData%Input,1) - CALL MD_DestroyInput( MD_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyInput( MD_DataData%Input(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MD_DataData%Input) @@ -5416,9 +5360,9 @@ SUBROUTINE Farm_DestroyMD_Data( MD_DataData, ErrStat, ErrMsg, DEALLOCATEpointers IF (ALLOCATED(MD_DataData%InputTimes)) THEN DEALLOCATE(MD_DataData%InputTimes) ENDIF - CALL MD_DestroyOutput( MD_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyOutput( MD_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyMisc( MD_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyMisc( MD_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Farm_DestroyMD_Data @@ -6423,14 +6367,12 @@ SUBROUTINE Farm_CopyAll_FastFarm_Data( SrcAll_FastFarm_DataData, DstAll_FastFarm IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE Farm_CopyAll_FastFarm_Data - SUBROUTINE Farm_DestroyAll_FastFarm_Data( All_FastFarm_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Farm_DestroyAll_FastFarm_Data( All_FastFarm_DataData, ErrStat, ErrMsg ) TYPE(All_FastFarm_Data), INTENT(INOUT) :: All_FastFarm_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyAll_FastFarm_Data' @@ -6438,35 +6380,29 @@ SUBROUTINE Farm_DestroyAll_FastFarm_Data( All_FastFarm_DataData, ErrStat, ErrMsg ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL Farm_DestroyParam( All_FastFarm_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Farm_DestroyParam( All_FastFarm_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Farm_DestroyMisc( All_FastFarm_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Farm_DestroyMisc( All_FastFarm_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(All_FastFarm_DataData%FWrap)) THEN DO i1 = LBOUND(All_FastFarm_DataData%FWrap,1), UBOUND(All_FastFarm_DataData%FWrap,1) - CALL Farm_Destroyfastwrapper_data( All_FastFarm_DataData%FWrap(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Farm_DestroyFASTWrapper_Data( All_FastFarm_DataData%FWrap(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(All_FastFarm_DataData%FWrap) ENDIF IF (ALLOCATED(All_FastFarm_DataData%WD)) THEN DO i1 = LBOUND(All_FastFarm_DataData%WD,1), UBOUND(All_FastFarm_DataData%WD,1) - CALL Farm_Destroywakedynamics_data( All_FastFarm_DataData%WD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Farm_DestroyWakeDynamics_Data( All_FastFarm_DataData%WD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(All_FastFarm_DataData%WD) ENDIF - CALL Farm_Destroyawae_data( All_FastFarm_DataData%AWAE, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Farm_DestroyAWAE_Data( All_FastFarm_DataData%AWAE, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Farm_Destroysc_data( All_FastFarm_DataData%SC, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Farm_DestroySC_Data( All_FastFarm_DataData%SC, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Farm_Destroymd_data( All_FastFarm_DataData%MD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Farm_DestroyMD_Data( All_FastFarm_DataData%MD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Farm_DestroyAll_FastFarm_Data @@ -6545,7 +6481,7 @@ SUBROUTINE Farm_PackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Int_BufSz = Int_BufSz + 2*1 ! FWrap upper/lower bounds for each dimension DO i1 = LBOUND(InData%FWrap,1), UBOUND(InData%FWrap,1) Int_BufSz = Int_BufSz + 3 ! FWrap: size of buffers for each call to pack subtype - CALL Farm_Packfastwrapper_data( Re_Buf, Db_Buf, Int_Buf, InData%FWrap(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FWrap + CALL Farm_PackFASTWrapper_Data( Re_Buf, Db_Buf, Int_Buf, InData%FWrap(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FWrap CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6568,7 +6504,7 @@ SUBROUTINE Farm_PackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Int_BufSz = Int_BufSz + 2*1 ! WD upper/lower bounds for each dimension DO i1 = LBOUND(InData%WD,1), UBOUND(InData%WD,1) Int_BufSz = Int_BufSz + 3 ! WD: size of buffers for each call to pack subtype - CALL Farm_Packwakedynamics_data( Re_Buf, Db_Buf, Int_Buf, InData%WD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WD + CALL Farm_PackWakeDynamics_Data( Re_Buf, Db_Buf, Int_Buf, InData%WD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6587,7 +6523,7 @@ SUBROUTINE Farm_PackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt END DO END IF Int_BufSz = Int_BufSz + 3 ! AWAE: size of buffers for each call to pack subtype - CALL Farm_Packawae_data( Re_Buf, Db_Buf, Int_Buf, InData%AWAE, ErrStat2, ErrMsg2, .TRUE. ) ! AWAE + CALL Farm_PackAWAE_Data( Re_Buf, Db_Buf, Int_Buf, InData%AWAE, ErrStat2, ErrMsg2, .TRUE. ) ! AWAE CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6604,7 +6540,7 @@ SUBROUTINE Farm_PackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! SC: size of buffers for each call to pack subtype - CALL Farm_Packsc_data( Re_Buf, Db_Buf, Int_Buf, InData%SC, ErrStat2, ErrMsg2, .TRUE. ) ! SC + CALL Farm_PackSC_Data( Re_Buf, Db_Buf, Int_Buf, InData%SC, ErrStat2, ErrMsg2, .TRUE. ) ! SC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6621,7 +6557,7 @@ SUBROUTINE Farm_PackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! MD: size of buffers for each call to pack subtype - CALL Farm_Packmd_data( Re_Buf, Db_Buf, Int_Buf, InData%MD, ErrStat2, ErrMsg2, .TRUE. ) ! MD + CALL Farm_PackMD_Data( Re_Buf, Db_Buf, Int_Buf, InData%MD, ErrStat2, ErrMsg2, .TRUE. ) ! MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6731,7 +6667,7 @@ SUBROUTINE Farm_PackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%FWrap,1), UBOUND(InData%FWrap,1) - CALL Farm_Packfastwrapper_data( Re_Buf, Db_Buf, Int_Buf, InData%FWrap(i1), ErrStat2, ErrMsg2, OnlySize ) ! FWrap + CALL Farm_PackFASTWrapper_Data( Re_Buf, Db_Buf, Int_Buf, InData%FWrap(i1), ErrStat2, ErrMsg2, OnlySize ) ! FWrap CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6772,7 +6708,7 @@ SUBROUTINE Farm_PackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%WD,1), UBOUND(InData%WD,1) - CALL Farm_Packwakedynamics_data( Re_Buf, Db_Buf, Int_Buf, InData%WD(i1), ErrStat2, ErrMsg2, OnlySize ) ! WD + CALL Farm_PackWakeDynamics_Data( Re_Buf, Db_Buf, Int_Buf, InData%WD(i1), ErrStat2, ErrMsg2, OnlySize ) ! WD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6802,7 +6738,7 @@ SUBROUTINE Farm_PackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt ENDIF END DO END IF - CALL Farm_Packawae_data( Re_Buf, Db_Buf, Int_Buf, InData%AWAE, ErrStat2, ErrMsg2, OnlySize ) ! AWAE + CALL Farm_PackAWAE_Data( Re_Buf, Db_Buf, Int_Buf, InData%AWAE, ErrStat2, ErrMsg2, OnlySize ) ! AWAE CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6830,7 +6766,7 @@ SUBROUTINE Farm_PackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL Farm_Packsc_data( Re_Buf, Db_Buf, Int_Buf, InData%SC, ErrStat2, ErrMsg2, OnlySize ) ! SC + CALL Farm_PackSC_Data( Re_Buf, Db_Buf, Int_Buf, InData%SC, ErrStat2, ErrMsg2, OnlySize ) ! SC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6858,7 +6794,7 @@ SUBROUTINE Farm_PackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL Farm_Packmd_data( Re_Buf, Db_Buf, Int_Buf, InData%MD, ErrStat2, ErrMsg2, OnlySize ) ! MD + CALL Farm_PackMD_Data( Re_Buf, Db_Buf, Int_Buf, InData%MD, ErrStat2, ErrMsg2, OnlySize ) ! MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7042,7 +6978,7 @@ SUBROUTINE Farm_UnPackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Farm_Unpackfastwrapper_data( Re_Buf, Db_Buf, Int_Buf, OutData%FWrap(i1), ErrStat2, ErrMsg2 ) ! FWrap + CALL Farm_UnpackFASTWrapper_Data( Re_Buf, Db_Buf, Int_Buf, OutData%FWrap(i1), ErrStat2, ErrMsg2 ) ! FWrap CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7098,7 +7034,7 @@ SUBROUTINE Farm_UnPackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Farm_Unpackwakedynamics_data( Re_Buf, Db_Buf, Int_Buf, OutData%WD(i1), ErrStat2, ErrMsg2 ) ! WD + CALL Farm_UnpackWakeDynamics_Data( Re_Buf, Db_Buf, Int_Buf, OutData%WD(i1), ErrStat2, ErrMsg2 ) ! WD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7140,7 +7076,7 @@ SUBROUTINE Farm_UnPackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Farm_Unpackawae_data( Re_Buf, Db_Buf, Int_Buf, OutData%AWAE, ErrStat2, ErrMsg2 ) ! AWAE + CALL Farm_UnpackAWAE_Data( Re_Buf, Db_Buf, Int_Buf, OutData%AWAE, ErrStat2, ErrMsg2 ) ! AWAE CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7180,7 +7116,7 @@ SUBROUTINE Farm_UnPackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Farm_Unpacksc_data( Re_Buf, Db_Buf, Int_Buf, OutData%SC, ErrStat2, ErrMsg2 ) ! SC + CALL Farm_UnpackSC_Data( Re_Buf, Db_Buf, Int_Buf, OutData%SC, ErrStat2, ErrMsg2 ) ! SC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7220,7 +7156,7 @@ SUBROUTINE Farm_UnPackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Farm_Unpackmd_data( Re_Buf, Db_Buf, Int_Buf, OutData%MD, ErrStat2, ErrMsg2 ) ! MD + CALL Farm_UnpackMD_Data( Re_Buf, Db_Buf, Int_Buf, OutData%MD, ErrStat2, ErrMsg2 ) ! MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 8a702ba2fb..7b50f3ae2b 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -73,7 +73,7 @@ MODULE AeroAcoustics_Types ! ======================= ! ========= AA_InputFile ======= TYPE, PUBLIC :: AA_InputFile - REAL(DbKi) :: DT_AA !< Time interval for aerodynamic calculations {or "default"} [s] + REAL(DbKi) :: DT_AA !< Time interval for aerodynamic calculations {or [default"}"] INTEGER(IntKi) :: IBLUNT !< FLAG TO COMPUTE BLUNTNESS NOISE [-] INTEGER(IntKi) :: ILAM !< FLAG TO COMPUTE LBL NOISE {1=steady model, 2=Beddoes-Leishman unsteady model} [-] INTEGER(IntKi) :: ITIP !< FLAG TO COMPUTE TIP NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] @@ -286,10 +286,6 @@ SUBROUTINE AA_CopyBladePropsType( SrcBladePropsTypeData, DstBladePropsTypeData, CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyBladePropsType' @@ -300,14 +296,12 @@ SUBROUTINE AA_CopyBladePropsType( SrcBladePropsTypeData, DstBladePropsTypeData, DstBladePropsTypeData%TEAngle = SrcBladePropsTypeData%TEAngle END SUBROUTINE AA_CopyBladePropsType - SUBROUTINE AA_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AA_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg ) TYPE(AA_BladePropsType), INTENT(INOUT) :: BladePropsTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyBladePropsType' @@ -315,12 +309,6 @@ SUBROUTINE AA_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AA_DestroyBladePropsType SUBROUTINE AA_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -406,10 +394,6 @@ SUBROUTINE AA_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackBladePropsType' @@ -513,14 +497,12 @@ SUBROUTINE AA_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt ENDIF END SUBROUTINE AA_CopyInitInput - SUBROUTINE AA_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AA_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(AA_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInitInput' @@ -528,12 +510,6 @@ SUBROUTINE AA_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%BlSpn)) THEN DEALLOCATE(InitInputData%BlSpn) ENDIF @@ -545,7 +521,7 @@ SUBROUTINE AA_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointe ENDIF IF (ALLOCATED(InitInputData%AFInfo)) THEN DO i1 = LBOUND(InitInputData%AFInfo,1), UBOUND(InitInputData%AFInfo,1) - CALL AFI_DestroyParam( InitInputData%AFInfo(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AFI_DestroyParam( InitInputData%AFInfo(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InitInputData%AFInfo) @@ -1077,14 +1053,12 @@ SUBROUTINE AA_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%AirDens = SrcInitOutputData%AirDens END SUBROUTINE AA_CopyInitOutput - SUBROUTINE AA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(AA_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInitOutput' @@ -1092,12 +1066,6 @@ SUBROUTINE AA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) ENDIF @@ -1122,7 +1090,7 @@ SUBROUTINE AA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpoin IF (ALLOCATED(InitOutputData%WriteOutputUntNodes)) THEN DEALLOCATE(InitOutputData%WriteOutputUntNodes) ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AA_DestroyInitOutput @@ -1204,7 +1172,7 @@ SUBROUTINE AA_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 1*LEN(InData%delim) ! delim ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1388,7 +1356,7 @@ SUBROUTINE AA_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf(Int_Xferred) = ICHAR(InData%delim(I:I), IntKi) Int_Xferred = Int_Xferred + 1 END DO ! I - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1644,7 +1612,7 @@ SUBROUTINE AA_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1927,14 +1895,12 @@ SUBROUTINE AA_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%dy_turb_in = SrcInputFileData%dy_turb_in END SUBROUTINE AA_CopyInputFile - SUBROUTINE AA_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AA_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) TYPE(AA_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInputFile' @@ -1942,12 +1908,6 @@ SUBROUTINE AA_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputFileData%ObsX)) THEN DEALLOCATE(InputFileData%ObsX) ENDIF @@ -1959,7 +1919,7 @@ SUBROUTINE AA_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointe ENDIF IF (ALLOCATED(InputFileData%BladeProps)) THEN DO i1 = LBOUND(InputFileData%BladeProps,1), UBOUND(InputFileData%BladeProps,1) - CALL AA_Destroybladepropstype( InputFileData%BladeProps(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AA_DestroyBladePropsType( InputFileData%BladeProps(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InputFileData%BladeProps) @@ -2073,7 +2033,7 @@ SUBROUTINE AA_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) Int_BufSz = Int_BufSz + 3 ! BladeProps: size of buffers for each call to pack subtype - CALL AA_Packbladepropstype( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeProps + CALL AA_PackBladePropsType( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeProps CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2272,7 +2232,7 @@ SUBROUTINE AA_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) - CALL AA_Packbladepropstype( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeProps + CALL AA_PackBladePropsType( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeProps CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2751,7 +2711,7 @@ SUBROUTINE AA_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AA_Unpackbladepropstype( Re_Buf, Db_Buf, Int_Buf, OutData%BladeProps(i1), ErrStat2, ErrMsg2 ) ! BladeProps + CALL AA_UnpackBladePropsType( Re_Buf, Db_Buf, Int_Buf, OutData%BladeProps(i1), ErrStat2, ErrMsg2 ) ! BladeProps CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3102,14 +3062,12 @@ SUBROUTINE AA_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrSt DstContStateData%DummyContState = SrcContStateData%DummyContState END SUBROUTINE AA_CopyContState - SUBROUTINE AA_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AA_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(AA_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyContState' @@ -3117,12 +3075,6 @@ SUBROUTINE AA_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AA_DestroyContState SUBROUTINE AA_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -3399,14 +3351,12 @@ SUBROUTINE AA_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt ENDIF END SUBROUTINE AA_CopyDiscState - SUBROUTINE AA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(AA_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyDiscState' @@ -3414,12 +3364,6 @@ SUBROUTINE AA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(DiscStateData%MeanVrel)) THEN DEALLOCATE(DiscStateData%MeanVrel) ENDIF @@ -4115,14 +4059,12 @@ SUBROUTINE AA_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE AA_CopyConstrState - SUBROUTINE AA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(AA_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyConstrState' @@ -4130,12 +4072,6 @@ SUBROUTINE AA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AA_DestroyConstrState SUBROUTINE AA_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -4252,14 +4188,12 @@ SUBROUTINE AA_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState END SUBROUTINE AA_CopyOtherState - SUBROUTINE AA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(AA_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyOtherState' @@ -4267,12 +4201,6 @@ SUBROUTINE AA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AA_DestroyOtherState SUBROUTINE AA_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -4674,14 +4602,12 @@ SUBROUTINE AA_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%filesopen = SrcMiscData%filesopen END SUBROUTINE AA_CopyMisc - SUBROUTINE AA_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AA_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(AA_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyMisc' @@ -4689,12 +4615,6 @@ SUBROUTINE AA_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MiscData%AllOuts)) THEN DEALLOCATE(MiscData%AllOuts) ENDIF @@ -6324,14 +6244,12 @@ SUBROUTINE AA_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AA_CopyParam - SUBROUTINE AA_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AA_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(AA_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyParam' @@ -6339,12 +6257,6 @@ SUBROUTINE AA_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%rotorregionlimitsVert)) THEN DEALLOCATE(ParamData%rotorregionlimitsVert) ENDIF @@ -6377,7 +6289,7 @@ SUBROUTINE AA_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) @@ -6399,7 +6311,7 @@ SUBROUTINE AA_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(ParamData%AFInfo)) THEN DO i1 = LBOUND(ParamData%AFInfo,1), UBOUND(ParamData%AFInfo,1) - CALL AFI_DestroyParam( ParamData%AFInfo(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AFI_DestroyParam( ParamData%AFInfo(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%AFInfo) @@ -6587,7 +6499,7 @@ SUBROUTINE AA_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7019,7 +6931,7 @@ SUBROUTINE AA_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7896,7 +7808,7 @@ SUBROUTINE AA_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8566,14 +8478,12 @@ SUBROUTINE AA_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AA_CopyInput - SUBROUTINE AA_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AA_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(AA_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInput' @@ -8581,12 +8491,6 @@ SUBROUTINE AA_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputData%RotGtoL)) THEN DEALLOCATE(InputData%RotGtoL) ENDIF @@ -9158,14 +9062,12 @@ SUBROUTINE AA_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs ENDIF END SUBROUTINE AA_CopyOutput - SUBROUTINE AA_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AA_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(AA_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyOutput' @@ -9173,12 +9075,6 @@ SUBROUTINE AA_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%SumSpecNoise)) THEN DEALLOCATE(OutputData%SumSpecNoise) ENDIF diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index cb59d0248f..2982bfff30 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -31,6 +31,7 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE AeroDyn_Driver_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE AeroDyn_Types USE AeroDyn_Inflow_Types USE NWTC_Library IMPLICIT NONE @@ -205,9 +206,6 @@ SUBROUTINE AD_Dvr_CopyDvr_Case( SrcDvr_CaseData, DstDvr_CaseData, CtrlCode, ErrS CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_CopyDvr_Case' @@ -227,14 +225,12 @@ SUBROUTINE AD_Dvr_CopyDvr_Case( SrcDvr_CaseData, DstDvr_CaseData, CtrlCode, ErrS DstDvr_CaseData%frequency = SrcDvr_CaseData%frequency END SUBROUTINE AD_Dvr_CopyDvr_Case - SUBROUTINE AD_Dvr_DestroyDvr_Case( Dvr_CaseData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_Dvr_DestroyDvr_Case( Dvr_CaseData, ErrStat, ErrMsg ) TYPE(Dvr_Case), INTENT(INOUT) :: Dvr_CaseData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_Case' @@ -242,12 +238,6 @@ SUBROUTINE AD_Dvr_DestroyDvr_Case( Dvr_CaseData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AD_Dvr_DestroyDvr_Case SUBROUTINE AD_Dvr_PackDvr_Case( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -360,9 +350,6 @@ SUBROUTINE AD_Dvr_UnPackDvr_Case( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackDvr_Case' @@ -421,14 +408,12 @@ SUBROUTINE AD_Dvr_CopyDvrVTK_SurfaceType( SrcDvrVTK_SurfaceTypeData, DstDvrVTK_S DstDvrVTK_SurfaceTypeData%BaseBox = SrcDvrVTK_SurfaceTypeData%BaseBox END SUBROUTINE AD_Dvr_CopyDvrVTK_SurfaceType - SUBROUTINE AD_Dvr_DestroyDvrVTK_SurfaceType( DvrVTK_SurfaceTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_Dvr_DestroyDvrVTK_SurfaceType( DvrVTK_SurfaceTypeData, ErrStat, ErrMsg ) TYPE(DvrVTK_SurfaceType), INTENT(INOUT) :: DvrVTK_SurfaceTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvrVTK_SurfaceType' @@ -436,12 +421,6 @@ SUBROUTINE AD_Dvr_DestroyDvrVTK_SurfaceType( DvrVTK_SurfaceTypeData, ErrStat, Er ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AD_Dvr_DestroyDvrVTK_SurfaceType SUBROUTINE AD_Dvr_PackDvrVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -697,14 +676,12 @@ SUBROUTINE AD_Dvr_CopyDvr_Outputs( SrcDvr_OutputsData, DstDvr_OutputsData, CtrlC DstDvr_OutputsData%n_DT_Out = SrcDvr_OutputsData%n_DT_Out END SUBROUTINE AD_Dvr_CopyDvr_Outputs - SUBROUTINE AD_Dvr_DestroyDvr_Outputs( Dvr_OutputsData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_Dvr_DestroyDvr_Outputs( Dvr_OutputsData, ErrStat, ErrMsg ) TYPE(Dvr_Outputs), INTENT(INOUT) :: Dvr_OutputsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_Outputs' @@ -712,13 +689,7 @@ SUBROUTINE AD_Dvr_DestroyDvr_Outputs( Dvr_OutputsData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( Dvr_OutputsData%AD_ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( Dvr_OutputsData%AD_ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(Dvr_OutputsData%unOutFile)) THEN DEALLOCATE(Dvr_OutputsData%unOutFile) @@ -737,7 +708,7 @@ SUBROUTINE AD_Dvr_DestroyDvr_Outputs( Dvr_OutputsData, ErrStat, ErrMsg, DEALLOCA ENDIF IF (ALLOCATED(Dvr_OutputsData%VTK_surface)) THEN DO i1 = LBOUND(Dvr_OutputsData%VTK_surface,1), UBOUND(Dvr_OutputsData%VTK_surface,1) - CALL AD_Dvr_Destroydvrvtk_surfacetype( Dvr_OutputsData%VTK_surface(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_Dvr_DestroyDvrVTK_SurfaceType( Dvr_OutputsData%VTK_surface(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(Dvr_OutputsData%VTK_surface) @@ -781,7 +752,7 @@ SUBROUTINE AD_Dvr_PackDvr_Outputs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! AD_ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%AD_ver, ErrStat2, ErrMsg2, .TRUE. ) ! AD_ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%AD_ver, ErrStat2, ErrMsg2, .TRUE. ) ! AD_ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -838,7 +809,7 @@ SUBROUTINE AD_Dvr_PackDvr_Outputs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! VTK_surface upper/lower bounds for each dimension DO i1 = LBOUND(InData%VTK_surface,1), UBOUND(InData%VTK_surface,1) Int_BufSz = Int_BufSz + 3 ! VTK_surface: size of buffers for each call to pack subtype - CALL AD_Dvr_Packdvrvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface(i1), ErrStat2, ErrMsg2, .TRUE. ) ! VTK_surface + CALL AD_Dvr_PackDvrVTK_SurfaceType( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface(i1), ErrStat2, ErrMsg2, .TRUE. ) ! VTK_surface CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -890,7 +861,7 @@ SUBROUTINE AD_Dvr_PackDvr_Outputs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%AD_ver, ErrStat2, ErrMsg2, OnlySize ) ! AD_ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%AD_ver, ErrStat2, ErrMsg2, OnlySize ) ! AD_ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1052,7 +1023,7 @@ SUBROUTINE AD_Dvr_PackDvr_Outputs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%VTK_surface,1), UBOUND(InData%VTK_surface,1) - CALL AD_Dvr_Packdvrvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface(i1), ErrStat2, ErrMsg2, OnlySize ) ! VTK_surface + CALL AD_Dvr_PackDvrVTK_SurfaceType( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface(i1), ErrStat2, ErrMsg2, OnlySize ) ! VTK_surface CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1164,7 +1135,7 @@ SUBROUTINE AD_Dvr_UnPackDvr_Outputs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%AD_ver, ErrStat2, ErrMsg2 ) ! AD_ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%AD_ver, ErrStat2, ErrMsg2 ) ! AD_ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1356,7 +1327,7 @@ SUBROUTINE AD_Dvr_UnPackDvr_Outputs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Dvr_Unpackdvrvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_surface(i1), ErrStat2, ErrMsg2 ) ! VTK_surface + CALL AD_Dvr_UnpackDvrVTK_SurfaceType( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_surface(i1), ErrStat2, ErrMsg2 ) ! VTK_surface CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1431,14 +1402,12 @@ SUBROUTINE AD_Dvr_CopyBladeData( SrcBladeDataData, DstBladeDataData, CtrlCode, E DstBladeDataData%motionFileName = SrcBladeDataData%motionFileName END SUBROUTINE AD_Dvr_CopyBladeData - SUBROUTINE AD_Dvr_DestroyBladeData( BladeDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_Dvr_DestroyBladeData( BladeDataData, ErrStat, ErrMsg ) TYPE(BladeData), INTENT(INOUT) :: BladeDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyBladeData' @@ -1446,12 +1415,6 @@ SUBROUTINE AD_Dvr_DestroyBladeData( BladeDataData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(BladeDataData%motion)) THEN DEALLOCATE(BladeDataData%motion) ENDIF @@ -1717,14 +1680,12 @@ SUBROUTINE AD_Dvr_CopyHubData( SrcHubDataData, DstHubDataData, CtrlCode, ErrStat ENDIF END SUBROUTINE AD_Dvr_CopyHubData - SUBROUTINE AD_Dvr_DestroyHubData( HubDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_Dvr_DestroyHubData( HubDataData, ErrStat, ErrMsg ) TYPE(HubData), INTENT(INOUT) :: HubDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyHubData' @@ -1732,12 +1693,6 @@ SUBROUTINE AD_Dvr_DestroyHubData( HubDataData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(HubDataData%motion)) THEN DEALLOCATE(HubDataData%motion) ENDIF @@ -1980,14 +1935,12 @@ SUBROUTINE AD_Dvr_CopyNacData( SrcNacDataData, DstNacDataData, CtrlCode, ErrStat ENDIF END SUBROUTINE AD_Dvr_CopyNacData - SUBROUTINE AD_Dvr_DestroyNacData( NacDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_Dvr_DestroyNacData( NacDataData, ErrStat, ErrMsg ) TYPE(NacData), INTENT(INOUT) :: NacDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyNacData' @@ -1995,12 +1948,6 @@ SUBROUTINE AD_Dvr_DestroyNacData( NacDataData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(NacDataData%motion)) THEN DEALLOCATE(NacDataData%motion) ENDIF @@ -2211,14 +2158,12 @@ SUBROUTINE AD_Dvr_CopyTwrData( SrcTwrDataData, DstTwrDataData, CtrlCode, ErrStat DstTwrDataData%origin_t = SrcTwrDataData%origin_t END SUBROUTINE AD_Dvr_CopyTwrData - SUBROUTINE AD_Dvr_DestroyTwrData( TwrDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_Dvr_DestroyTwrData( TwrDataData, ErrStat, ErrMsg ) TYPE(TwrData), INTENT(INOUT) :: TwrDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyTwrData' @@ -2226,12 +2171,6 @@ SUBROUTINE AD_Dvr_DestroyTwrData( TwrDataData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AD_Dvr_DestroyTwrData SUBROUTINE AD_Dvr_PackTwrData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2458,14 +2397,12 @@ SUBROUTINE AD_Dvr_CopyWTData( SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, E ENDIF END SUBROUTINE AD_Dvr_CopyWTData - SUBROUTINE AD_Dvr_DestroyWTData( WTDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_Dvr_DestroyWTData( WTDataData, ErrStat, ErrMsg ) TYPE(WTData), INTENT(INOUT) :: WTDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyWTData' @@ -2473,37 +2410,31 @@ SUBROUTINE AD_Dvr_DestroyWTData( WTDataData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroymeshmaptype( WTDataData%map2twrPt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( WTDataData%map2twrPt, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( WTDataData%map2nacPt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( WTDataData%map2nacPt, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( WTDataData%map2hubPt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( WTDataData%map2hubPt, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(WTDataData%map2BldPt)) THEN DO i1 = LBOUND(WTDataData%map2BldPt,1), UBOUND(WTDataData%map2BldPt,1) - CALL NWTC_Library_Destroymeshmaptype( WTDataData%map2BldPt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( WTDataData%map2BldPt(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(WTDataData%map2BldPt) ENDIF IF (ALLOCATED(WTDataData%bld)) THEN DO i1 = LBOUND(WTDataData%bld,1), UBOUND(WTDataData%bld,1) - CALL AD_Dvr_Destroybladedata( WTDataData%bld(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_Dvr_DestroyBladeData( WTDataData%bld(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(WTDataData%bld) ENDIF - CALL AD_Dvr_Destroyhubdata( WTDataData%hub, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_Dvr_DestroyHubData( WTDataData%hub, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_Dvr_Destroynacdata( WTDataData%nac, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_Dvr_DestroyNacData( WTDataData%nac, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_Dvr_Destroytwrdata( WTDataData%twr, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_Dvr_DestroyTwrData( WTDataData%twr, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(WTDataData%motion)) THEN DEALLOCATE(WTDataData%motion) @@ -2555,7 +2486,7 @@ SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Re_BufSz = Re_BufSz + SIZE(InData%orientationInit) ! orientationInit ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! map2twrPt: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2twrPt, ErrStat2, ErrMsg2, .TRUE. ) ! map2twrPt + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%map2twrPt, ErrStat2, ErrMsg2, .TRUE. ) ! map2twrPt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2572,7 +2503,7 @@ SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! map2nacPt: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2nacPt, ErrStat2, ErrMsg2, .TRUE. ) ! map2nacPt + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%map2nacPt, ErrStat2, ErrMsg2, .TRUE. ) ! map2nacPt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2589,7 +2520,7 @@ SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! map2hubPt: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2hubPt, ErrStat2, ErrMsg2, .TRUE. ) ! map2hubPt + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%map2hubPt, ErrStat2, ErrMsg2, .TRUE. ) ! map2hubPt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2610,7 +2541,7 @@ SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 2*1 ! map2BldPt upper/lower bounds for each dimension DO i1 = LBOUND(InData%map2BldPt,1), UBOUND(InData%map2BldPt,1) Int_BufSz = Int_BufSz + 3 ! map2BldPt: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2BldPt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! map2BldPt + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%map2BldPt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! map2BldPt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2633,7 +2564,7 @@ SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 2*1 ! bld upper/lower bounds for each dimension DO i1 = LBOUND(InData%bld,1), UBOUND(InData%bld,1) Int_BufSz = Int_BufSz + 3 ! bld: size of buffers for each call to pack subtype - CALL AD_Dvr_Packbladedata( Re_Buf, Db_Buf, Int_Buf, InData%bld(i1), ErrStat2, ErrMsg2, .TRUE. ) ! bld + CALL AD_Dvr_PackBladeData( Re_Buf, Db_Buf, Int_Buf, InData%bld(i1), ErrStat2, ErrMsg2, .TRUE. ) ! bld CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2652,7 +2583,7 @@ SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END DO END IF Int_BufSz = Int_BufSz + 3 ! hub: size of buffers for each call to pack subtype - CALL AD_Dvr_Packhubdata( Re_Buf, Db_Buf, Int_Buf, InData%hub, ErrStat2, ErrMsg2, .TRUE. ) ! hub + CALL AD_Dvr_PackHubData( Re_Buf, Db_Buf, Int_Buf, InData%hub, ErrStat2, ErrMsg2, .TRUE. ) ! hub CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2669,7 +2600,7 @@ SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! nac: size of buffers for each call to pack subtype - CALL AD_Dvr_Packnacdata( Re_Buf, Db_Buf, Int_Buf, InData%nac, ErrStat2, ErrMsg2, .TRUE. ) ! nac + CALL AD_Dvr_PackNacData( Re_Buf, Db_Buf, Int_Buf, InData%nac, ErrStat2, ErrMsg2, .TRUE. ) ! nac CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2686,7 +2617,7 @@ SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! twr: size of buffers for each call to pack subtype - CALL AD_Dvr_Packtwrdata( Re_Buf, Db_Buf, Int_Buf, InData%twr, ErrStat2, ErrMsg2, .TRUE. ) ! twr + CALL AD_Dvr_PackTwrData( Re_Buf, Db_Buf, Int_Buf, InData%twr, ErrStat2, ErrMsg2, .TRUE. ) ! twr CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2764,7 +2695,7 @@ SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ReKiBuf(Re_Xferred) = InData%orientationInit(i1) Re_Xferred = Re_Xferred + 1 END DO - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2twrPt, ErrStat2, ErrMsg2, OnlySize ) ! map2twrPt + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%map2twrPt, ErrStat2, ErrMsg2, OnlySize ) ! map2twrPt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2792,7 +2723,7 @@ SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2nacPt, ErrStat2, ErrMsg2, OnlySize ) ! map2nacPt + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%map2nacPt, ErrStat2, ErrMsg2, OnlySize ) ! map2nacPt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2820,7 +2751,7 @@ SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2hubPt, ErrStat2, ErrMsg2, OnlySize ) ! map2hubPt + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%map2hubPt, ErrStat2, ErrMsg2, OnlySize ) ! map2hubPt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2859,7 +2790,7 @@ SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%map2BldPt,1), UBOUND(InData%map2BldPt,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%map2BldPt(i1), ErrStat2, ErrMsg2, OnlySize ) ! map2BldPt + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%map2BldPt(i1), ErrStat2, ErrMsg2, OnlySize ) ! map2BldPt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2900,7 +2831,7 @@ SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%bld,1), UBOUND(InData%bld,1) - CALL AD_Dvr_Packbladedata( Re_Buf, Db_Buf, Int_Buf, InData%bld(i1), ErrStat2, ErrMsg2, OnlySize ) ! bld + CALL AD_Dvr_PackBladeData( Re_Buf, Db_Buf, Int_Buf, InData%bld(i1), ErrStat2, ErrMsg2, OnlySize ) ! bld CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2930,7 +2861,7 @@ SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ENDIF END DO END IF - CALL AD_Dvr_Packhubdata( Re_Buf, Db_Buf, Int_Buf, InData%hub, ErrStat2, ErrMsg2, OnlySize ) ! hub + CALL AD_Dvr_PackHubData( Re_Buf, Db_Buf, Int_Buf, InData%hub, ErrStat2, ErrMsg2, OnlySize ) ! hub CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2958,7 +2889,7 @@ SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD_Dvr_Packnacdata( Re_Buf, Db_Buf, Int_Buf, InData%nac, ErrStat2, ErrMsg2, OnlySize ) ! nac + CALL AD_Dvr_PackNacData( Re_Buf, Db_Buf, Int_Buf, InData%nac, ErrStat2, ErrMsg2, OnlySize ) ! nac CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2986,7 +2917,7 @@ SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD_Dvr_Packtwrdata( Re_Buf, Db_Buf, Int_Buf, InData%twr, ErrStat2, ErrMsg2, OnlySize ) ! twr + CALL AD_Dvr_PackTwrData( Re_Buf, Db_Buf, Int_Buf, InData%twr, ErrStat2, ErrMsg2, OnlySize ) ! twr CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3165,7 +3096,7 @@ SUBROUTINE AD_Dvr_UnPackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%map2twrPt, ErrStat2, ErrMsg2 ) ! map2twrPt + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%map2twrPt, ErrStat2, ErrMsg2 ) ! map2twrPt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3205,7 +3136,7 @@ SUBROUTINE AD_Dvr_UnPackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%map2nacPt, ErrStat2, ErrMsg2 ) ! map2nacPt + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%map2nacPt, ErrStat2, ErrMsg2 ) ! map2nacPt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3245,7 +3176,7 @@ SUBROUTINE AD_Dvr_UnPackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%map2hubPt, ErrStat2, ErrMsg2 ) ! map2hubPt + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%map2hubPt, ErrStat2, ErrMsg2 ) ! map2hubPt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3299,7 +3230,7 @@ SUBROUTINE AD_Dvr_UnPackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%map2BldPt(i1), ErrStat2, ErrMsg2 ) ! map2BldPt + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%map2BldPt(i1), ErrStat2, ErrMsg2 ) ! map2BldPt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3355,7 +3286,7 @@ SUBROUTINE AD_Dvr_UnPackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Dvr_Unpackbladedata( Re_Buf, Db_Buf, Int_Buf, OutData%bld(i1), ErrStat2, ErrMsg2 ) ! bld + CALL AD_Dvr_UnpackBladeData( Re_Buf, Db_Buf, Int_Buf, OutData%bld(i1), ErrStat2, ErrMsg2 ) ! bld CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3397,7 +3328,7 @@ SUBROUTINE AD_Dvr_UnPackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Dvr_Unpackhubdata( Re_Buf, Db_Buf, Int_Buf, OutData%hub, ErrStat2, ErrMsg2 ) ! hub + CALL AD_Dvr_UnpackHubData( Re_Buf, Db_Buf, Int_Buf, OutData%hub, ErrStat2, ErrMsg2 ) ! hub CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3437,7 +3368,7 @@ SUBROUTINE AD_Dvr_UnPackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Dvr_Unpacknacdata( Re_Buf, Db_Buf, Int_Buf, OutData%nac, ErrStat2, ErrMsg2 ) ! nac + CALL AD_Dvr_UnpackNacData( Re_Buf, Db_Buf, Int_Buf, OutData%nac, ErrStat2, ErrMsg2 ) ! nac CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3477,7 +3408,7 @@ SUBROUTINE AD_Dvr_UnPackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Dvr_Unpacktwrdata( Re_Buf, Db_Buf, Int_Buf, OutData%twr, ErrStat2, ErrMsg2 ) ! twr + CALL AD_Dvr_UnpackTwrData( Re_Buf, Db_Buf, Int_Buf, OutData%twr, ErrStat2, ErrMsg2 ) ! twr CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3659,14 +3590,12 @@ SUBROUTINE AD_Dvr_CopyDvr_SimData( SrcDvr_SimDataData, DstDvr_SimDataData, CtrlC IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_Dvr_CopyDvr_SimData - SUBROUTINE AD_Dvr_DestroyDvr_SimData( Dvr_SimDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_Dvr_DestroyDvr_SimData( Dvr_SimDataData, ErrStat, ErrMsg ) TYPE(Dvr_SimData), INTENT(INOUT) :: Dvr_SimDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_SimData' @@ -3674,22 +3603,16 @@ SUBROUTINE AD_Dvr_DestroyDvr_SimData( Dvr_SimDataData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(Dvr_SimDataData%WT)) THEN DO i1 = LBOUND(Dvr_SimDataData%WT,1), UBOUND(Dvr_SimDataData%WT,1) - CALL AD_Dvr_Destroywtdata( Dvr_SimDataData%WT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_Dvr_DestroyWTData( Dvr_SimDataData%WT(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(Dvr_SimDataData%WT) ENDIF IF (ALLOCATED(Dvr_SimDataData%Cases)) THEN DO i1 = LBOUND(Dvr_SimDataData%Cases,1), UBOUND(Dvr_SimDataData%Cases,1) - CALL AD_Dvr_Destroydvr_case( Dvr_SimDataData%Cases(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_Dvr_DestroyDvr_Case( Dvr_SimDataData%Cases(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(Dvr_SimDataData%Cases) @@ -3697,9 +3620,9 @@ SUBROUTINE AD_Dvr_DestroyDvr_SimData( Dvr_SimDataData, ErrStat, ErrMsg, DEALLOCA IF (ALLOCATED(Dvr_SimDataData%timeSeries)) THEN DEALLOCATE(Dvr_SimDataData%timeSeries) ENDIF - CALL AD_Dvr_Destroydvr_outputs( Dvr_SimDataData%out, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_Dvr_DestroyDvr_Outputs( Dvr_SimDataData%out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_Destroyiw_inputdata( Dvr_SimDataData%IW_InitInp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ADI_DestroyIW_InputData( Dvr_SimDataData%IW_InitInp, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_Dvr_DestroyDvr_SimData @@ -3755,7 +3678,7 @@ SUBROUTINE AD_Dvr_PackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%WT,1), UBOUND(InData%WT,1) Int_BufSz = Int_BufSz + 3 ! WT: size of buffers for each call to pack subtype - CALL AD_Dvr_Packwtdata( Re_Buf, Db_Buf, Int_Buf, InData%WT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WT + CALL AD_Dvr_PackWTData( Re_Buf, Db_Buf, Int_Buf, InData%WT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WT CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3782,7 +3705,7 @@ SUBROUTINE AD_Dvr_PackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! Cases upper/lower bounds for each dimension DO i1 = LBOUND(InData%Cases,1), UBOUND(InData%Cases,1) Int_BufSz = Int_BufSz + 3 ! Cases: size of buffers for each call to pack subtype - CALL AD_Dvr_Packdvr_case( Re_Buf, Db_Buf, Int_Buf, InData%Cases(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Cases + CALL AD_Dvr_PackDvr_Case( Re_Buf, Db_Buf, Int_Buf, InData%Cases(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Cases CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3809,7 +3732,7 @@ SUBROUTINE AD_Dvr_PackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 1 ! iTimeSeries Int_BufSz = Int_BufSz + 1*LEN(InData%root) ! root Int_BufSz = Int_BufSz + 3 ! out: size of buffers for each call to pack subtype - CALL AD_Dvr_Packdvr_outputs( Re_Buf, Db_Buf, Int_Buf, InData%out, ErrStat2, ErrMsg2, .TRUE. ) ! out + CALL AD_Dvr_PackDvr_Outputs( Re_Buf, Db_Buf, Int_Buf, InData%out, ErrStat2, ErrMsg2, .TRUE. ) ! out CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3826,7 +3749,7 @@ SUBROUTINE AD_Dvr_PackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! IW_InitInp: size of buffers for each call to pack subtype - CALL ADI_Packiw_inputdata( Re_Buf, Db_Buf, Int_Buf, InData%IW_InitInp, ErrStat2, ErrMsg2, .TRUE. ) ! IW_InitInp + CALL ADI_PackIW_InputData( Re_Buf, Db_Buf, Int_Buf, InData%IW_InitInp, ErrStat2, ErrMsg2, .TRUE. ) ! IW_InitInp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3904,7 +3827,7 @@ SUBROUTINE AD_Dvr_PackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%WT,1), UBOUND(InData%WT,1) - CALL AD_Dvr_Packwtdata( Re_Buf, Db_Buf, Int_Buf, InData%WT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WT + CALL AD_Dvr_PackWTData( Re_Buf, Db_Buf, Int_Buf, InData%WT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WT CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3953,7 +3876,7 @@ SUBROUTINE AD_Dvr_PackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%Cases,1), UBOUND(InData%Cases,1) - CALL AD_Dvr_Packdvr_case( Re_Buf, Db_Buf, Int_Buf, InData%Cases(i1), ErrStat2, ErrMsg2, OnlySize ) ! Cases + CALL AD_Dvr_PackDvr_Case( Re_Buf, Db_Buf, Int_Buf, InData%Cases(i1), ErrStat2, ErrMsg2, OnlySize ) ! Cases CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4011,7 +3934,7 @@ SUBROUTINE AD_Dvr_PackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf(Int_Xferred) = ICHAR(InData%root(I:I), IntKi) Int_Xferred = Int_Xferred + 1 END DO ! I - CALL AD_Dvr_Packdvr_outputs( Re_Buf, Db_Buf, Int_Buf, InData%out, ErrStat2, ErrMsg2, OnlySize ) ! out + CALL AD_Dvr_PackDvr_Outputs( Re_Buf, Db_Buf, Int_Buf, InData%out, ErrStat2, ErrMsg2, OnlySize ) ! out CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4039,7 +3962,7 @@ SUBROUTINE AD_Dvr_PackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL ADI_Packiw_inputdata( Re_Buf, Db_Buf, Int_Buf, InData%IW_InitInp, ErrStat2, ErrMsg2, OnlySize ) ! IW_InitInp + CALL ADI_PackIW_InputData( Re_Buf, Db_Buf, Int_Buf, InData%IW_InitInp, ErrStat2, ErrMsg2, OnlySize ) ! IW_InitInp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4168,7 +4091,7 @@ SUBROUTINE AD_Dvr_UnPackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Dvr_Unpackwtdata( Re_Buf, Db_Buf, Int_Buf, OutData%WT(i1), ErrStat2, ErrMsg2 ) ! WT + CALL AD_Dvr_UnpackWTData( Re_Buf, Db_Buf, Int_Buf, OutData%WT(i1), ErrStat2, ErrMsg2 ) ! WT CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4232,7 +4155,7 @@ SUBROUTINE AD_Dvr_UnPackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Dvr_Unpackdvr_case( Re_Buf, Db_Buf, Int_Buf, OutData%Cases(i1), ErrStat2, ErrMsg2 ) ! Cases + CALL AD_Dvr_UnpackDvr_Case( Re_Buf, Db_Buf, Int_Buf, OutData%Cases(i1), ErrStat2, ErrMsg2 ) ! Cases CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4305,7 +4228,7 @@ SUBROUTINE AD_Dvr_UnPackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Dvr_Unpackdvr_outputs( Re_Buf, Db_Buf, Int_Buf, OutData%out, ErrStat2, ErrMsg2 ) ! out + CALL AD_Dvr_UnpackDvr_Outputs( Re_Buf, Db_Buf, Int_Buf, OutData%out, ErrStat2, ErrMsg2 ) ! out CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4345,7 +4268,7 @@ SUBROUTINE AD_Dvr_UnPackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ADI_Unpackiw_inputdata( Re_Buf, Db_Buf, Int_Buf, OutData%IW_InitInp, ErrStat2, ErrMsg2 ) ! IW_InitInp + CALL ADI_UnpackIW_InputData( Re_Buf, Db_Buf, Int_Buf, OutData%IW_InitInp, ErrStat2, ErrMsg2 ) ! IW_InitInp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4382,14 +4305,12 @@ SUBROUTINE AD_Dvr_CopyAllData( SrcAllDataData, DstAllDataData, CtrlCode, ErrStat DstAllDataData%initialized = SrcAllDataData%initialized END SUBROUTINE AD_Dvr_CopyAllData - SUBROUTINE AD_Dvr_DestroyAllData( AllDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_Dvr_DestroyAllData( AllDataData, ErrStat, ErrMsg ) TYPE(AllData), INTENT(INOUT) :: AllDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyAllData' @@ -4397,17 +4318,11 @@ SUBROUTINE AD_Dvr_DestroyAllData( AllDataData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_Dvr_Destroydvr_simdata( AllDataData%dvr, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_Dvr_DestroyDvr_SimData( AllDataData%dvr, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_Destroydata( AllDataData%ADI, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ADI_DestroyData( AllDataData%ADI, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_Destroyfed_data( AllDataData%FED, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ADI_DestroyFED_Data( AllDataData%FED, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_Dvr_DestroyAllData @@ -4448,7 +4363,7 @@ SUBROUTINE AD_Dvr_PackAllData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! dvr: size of buffers for each call to pack subtype - CALL AD_Dvr_Packdvr_simdata( Re_Buf, Db_Buf, Int_Buf, InData%dvr, ErrStat2, ErrMsg2, .TRUE. ) ! dvr + CALL AD_Dvr_PackDvr_SimData( Re_Buf, Db_Buf, Int_Buf, InData%dvr, ErrStat2, ErrMsg2, .TRUE. ) ! dvr CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4465,7 +4380,7 @@ SUBROUTINE AD_Dvr_PackAllData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! ADI: size of buffers for each call to pack subtype - CALL ADI_Packdata( Re_Buf, Db_Buf, Int_Buf, InData%ADI, ErrStat2, ErrMsg2, .TRUE. ) ! ADI + CALL ADI_PackData( Re_Buf, Db_Buf, Int_Buf, InData%ADI, ErrStat2, ErrMsg2, .TRUE. ) ! ADI CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4482,7 +4397,7 @@ SUBROUTINE AD_Dvr_PackAllData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! FED: size of buffers for each call to pack subtype - CALL ADI_Packfed_data( Re_Buf, Db_Buf, Int_Buf, InData%FED, ErrStat2, ErrMsg2, .TRUE. ) ! FED + CALL ADI_PackFED_Data( Re_Buf, Db_Buf, Int_Buf, InData%FED, ErrStat2, ErrMsg2, .TRUE. ) ! FED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4528,7 +4443,7 @@ SUBROUTINE AD_Dvr_PackAllData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - CALL AD_Dvr_Packdvr_simdata( Re_Buf, Db_Buf, Int_Buf, InData%dvr, ErrStat2, ErrMsg2, OnlySize ) ! dvr + CALL AD_Dvr_PackDvr_SimData( Re_Buf, Db_Buf, Int_Buf, InData%dvr, ErrStat2, ErrMsg2, OnlySize ) ! dvr CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4556,7 +4471,7 @@ SUBROUTINE AD_Dvr_PackAllData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL ADI_Packdata( Re_Buf, Db_Buf, Int_Buf, InData%ADI, ErrStat2, ErrMsg2, OnlySize ) ! ADI + CALL ADI_PackData( Re_Buf, Db_Buf, Int_Buf, InData%ADI, ErrStat2, ErrMsg2, OnlySize ) ! ADI CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4584,7 +4499,7 @@ SUBROUTINE AD_Dvr_PackAllData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL ADI_Packfed_data( Re_Buf, Db_Buf, Int_Buf, InData%FED, ErrStat2, ErrMsg2, OnlySize ) ! FED + CALL ADI_PackFED_Data( Re_Buf, Db_Buf, Int_Buf, InData%FED, ErrStat2, ErrMsg2, OnlySize ) ! FED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4681,7 +4596,7 @@ SUBROUTINE AD_Dvr_UnPackAllData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Dvr_Unpackdvr_simdata( Re_Buf, Db_Buf, Int_Buf, OutData%dvr, ErrStat2, ErrMsg2 ) ! dvr + CALL AD_Dvr_UnpackDvr_SimData( Re_Buf, Db_Buf, Int_Buf, OutData%dvr, ErrStat2, ErrMsg2 ) ! dvr CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4721,7 +4636,7 @@ SUBROUTINE AD_Dvr_UnPackAllData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ADI_Unpackdata( Re_Buf, Db_Buf, Int_Buf, OutData%ADI, ErrStat2, ErrMsg2 ) ! ADI + CALL ADI_UnpackData( Re_Buf, Db_Buf, Int_Buf, OutData%ADI, ErrStat2, ErrMsg2 ) ! ADI CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4761,7 +4676,7 @@ SUBROUTINE AD_Dvr_UnPackAllData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ADI_Unpackfed_data( Re_Buf, Db_Buf, Int_Buf, OutData%FED, ErrStat2, ErrMsg2 ) ! FED + CALL ADI_UnpackFED_Data( Re_Buf, Db_Buf, Int_Buf, OutData%FED, ErrStat2, ErrMsg2 ) ! FED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index 9151ebda88..bd67bb6235 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -184,8 +184,6 @@ SUBROUTINE ADI_CopyInflowWindData( SrcInflowWindDataData, DstInflowWindDataData, CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ADI_CopyInflowWindData' @@ -222,14 +220,12 @@ SUBROUTINE ADI_CopyInflowWindData( SrcInflowWindDataData, DstInflowWindDataData, DstInflowWindDataData%PLExp = SrcInflowWindDataData%PLExp END SUBROUTINE ADI_CopyInflowWindData - SUBROUTINE ADI_DestroyInflowWindData( InflowWindDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ADI_DestroyInflowWindData( InflowWindDataData, ErrStat, ErrMsg ) TYPE(ADI_InflowWindData), INTENT(INOUT) :: InflowWindDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyInflowWindData' @@ -237,27 +233,21 @@ SUBROUTINE ADI_DestroyInflowWindData( InflowWindDataData, ErrStat, ErrMsg, DEALL ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL InflowWind_DestroyContState( InflowWindDataData%x, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyContState( InflowWindDataData%x, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyDiscState( InflowWindDataData%xd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyDiscState( InflowWindDataData%xd, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyConstrState( InflowWindDataData%z, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyConstrState( InflowWindDataData%z, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOtherState( InflowWindDataData%OtherSt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyOtherState( InflowWindDataData%OtherSt, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyParam( InflowWindDataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyParam( InflowWindDataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyMisc( InflowWindDataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyMisc( InflowWindDataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( InflowWindDataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyInput( InflowWindDataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( InflowWindDataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyOutput( InflowWindDataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE ADI_DestroyInflowWindData @@ -711,8 +701,6 @@ SUBROUTINE ADI_UnPackInflowWindData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackInflowWindData' @@ -1083,14 +1071,12 @@ SUBROUTINE ADI_CopyIW_InputData( SrcIW_InputDataData, DstIW_InputDataData, CtrlC DstIW_InputDataData%Linearize = SrcIW_InputDataData%Linearize END SUBROUTINE ADI_CopyIW_InputData - SUBROUTINE ADI_DestroyIW_InputData( IW_InputDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ADI_DestroyIW_InputData( IW_InputDataData, ErrStat, ErrMsg ) TYPE(ADI_IW_InputData), INTENT(INOUT) :: IW_InputDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyIW_InputData' @@ -1098,13 +1084,7 @@ SUBROUTINE ADI_DestroyIW_InputData( IW_InputDataData, ErrStat, ErrMsg, DEALLOCAT ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyfileinfotype( IW_InputDataData%PassedFileData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyFileInfoType( IW_InputDataData%PassedFileData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE ADI_DestroyIW_InputData @@ -1152,7 +1132,7 @@ SUBROUTINE ADI_PackIW_InputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_BufSz = Int_BufSz + 1 ! UseInputFile ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! PassedFileData: size of buffers for each call to pack subtype - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1212,7 +1192,7 @@ SUBROUTINE ADI_PackIW_InputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1319,7 +1299,7 @@ SUBROUTINE ADI_UnPackIW_InputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackfileinfotype( Re_Buf, Db_Buf, Int_Buf, OutData%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData + CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1357,14 +1337,12 @@ SUBROUTINE ADI_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth END SUBROUTINE ADI_CopyInitInput - SUBROUTINE ADI_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ADI_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(ADI_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyInitInput' @@ -1372,15 +1350,9 @@ SUBROUTINE ADI_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_DestroyInitInput( InitInputData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyInitInput( InitInputData%AD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_Destroyiw_inputdata( InitInputData%IW_InitInp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ADI_DestroyIW_InputData( InitInputData%IW_InitInp, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE ADI_DestroyInitInput @@ -1438,7 +1410,7 @@ SUBROUTINE ADI_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! IW_InitInp: size of buffers for each call to pack subtype - CALL ADI_Packiw_inputdata( Re_Buf, Db_Buf, Int_Buf, InData%IW_InitInp, ErrStat2, ErrMsg2, .TRUE. ) ! IW_InitInp + CALL ADI_PackIW_InputData( Re_Buf, Db_Buf, Int_Buf, InData%IW_InitInp, ErrStat2, ErrMsg2, .TRUE. ) ! IW_InitInp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1514,7 +1486,7 @@ SUBROUTINE ADI_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL ADI_Packiw_inputdata( Re_Buf, Db_Buf, Int_Buf, InData%IW_InitInp, ErrStat2, ErrMsg2, OnlySize ) ! IW_InitInp + CALL ADI_PackIW_InputData( Re_Buf, Db_Buf, Int_Buf, InData%IW_InitInp, ErrStat2, ErrMsg2, OnlySize ) ! IW_InitInp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1655,7 +1627,7 @@ SUBROUTINE ADI_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ADI_Unpackiw_inputdata( Re_Buf, Db_Buf, Int_Buf, OutData%IW_InitInp, ErrStat2, ErrMsg2 ) ! IW_InitInp + CALL ADI_UnpackIW_InputData( Re_Buf, Db_Buf, Int_Buf, OutData%IW_InitInp, ErrStat2, ErrMsg2 ) ! IW_InitInp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1720,14 +1692,12 @@ SUBROUTINE ADI_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, E ENDIF END SUBROUTINE ADI_CopyInitOutput - SUBROUTINE ADI_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ADI_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(ADI_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyInitOutput' @@ -1735,13 +1705,7 @@ SUBROUTINE ADI_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) @@ -1788,7 +1752,7 @@ SUBROUTINE ADI_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1841,7 +1805,7 @@ SUBROUTINE ADI_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1965,7 +1929,7 @@ SUBROUTINE ADI_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2033,14 +1997,12 @@ SUBROUTINE ADI_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrS IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE ADI_CopyContState - SUBROUTINE ADI_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ADI_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(ADI_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyContState' @@ -2048,13 +2010,7 @@ SUBROUTINE ADI_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_DestroyContState( ContStateData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyContState( ContStateData%AD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE ADI_DestroyContState @@ -2255,14 +2211,12 @@ SUBROUTINE ADI_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE ADI_CopyDiscState - SUBROUTINE ADI_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ADI_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(ADI_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyDiscState' @@ -2270,13 +2224,7 @@ SUBROUTINE ADI_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_DestroyDiscState( DiscStateData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyDiscState( DiscStateData%AD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE ADI_DestroyDiscState @@ -2477,14 +2425,12 @@ SUBROUTINE ADI_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE ADI_CopyConstrState - SUBROUTINE ADI_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ADI_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(ADI_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyConstrState' @@ -2492,13 +2438,7 @@ SUBROUTINE ADI_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_DestroyConstrState( ConstrStateData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyConstrState( ConstrStateData%AD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE ADI_DestroyConstrState @@ -2699,14 +2639,12 @@ SUBROUTINE ADI_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE ADI_CopyOtherState - SUBROUTINE ADI_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ADI_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(ADI_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyOtherState' @@ -2714,13 +2652,7 @@ SUBROUTINE ADI_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_DestroyOtherState( OtherStateData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyOtherState( OtherStateData%AD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE ADI_DestroyOtherState @@ -2941,14 +2873,12 @@ SUBROUTINE ADI_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE ADI_CopyMisc - SUBROUTINE ADI_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ADI_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(ADI_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyMisc' @@ -2956,19 +2886,13 @@ SUBROUTINE ADI_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_DestroyMisc( MiscData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyMisc( MiscData%AD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_Destroyinflowwinddata( MiscData%IW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ADI_DestroyInflowWindData( MiscData%IW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MiscData%VTK_surfaces)) THEN DO i1 = LBOUND(MiscData%VTK_surfaces,1), UBOUND(MiscData%VTK_surfaces,1) - CALL AD_Destroyvtk_rotsurfacetype( MiscData%VTK_surfaces(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyVTK_RotSurfaceType( MiscData%VTK_surfaces(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%VTK_surfaces) @@ -3029,7 +2953,7 @@ SUBROUTINE ADI_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! IW: size of buffers for each call to pack subtype - CALL ADI_Packinflowwinddata( Re_Buf, Db_Buf, Int_Buf, InData%IW, ErrStat2, ErrMsg2, .TRUE. ) ! IW + CALL ADI_PackInflowWindData( Re_Buf, Db_Buf, Int_Buf, InData%IW, ErrStat2, ErrMsg2, .TRUE. ) ! IW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3050,7 +2974,7 @@ SUBROUTINE ADI_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*1 ! VTK_surfaces upper/lower bounds for each dimension DO i1 = LBOUND(InData%VTK_surfaces,1), UBOUND(InData%VTK_surfaces,1) Int_BufSz = Int_BufSz + 3 ! VTK_surfaces: size of buffers for each call to pack subtype - CALL AD_Packvtk_rotsurfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surfaces(i1), ErrStat2, ErrMsg2, .TRUE. ) ! VTK_surfaces + CALL AD_PackVTK_RotSurfaceType( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surfaces(i1), ErrStat2, ErrMsg2, .TRUE. ) ! VTK_surfaces CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3123,7 +3047,7 @@ SUBROUTINE ADI_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL ADI_Packinflowwinddata( Re_Buf, Db_Buf, Int_Buf, InData%IW, ErrStat2, ErrMsg2, OnlySize ) ! IW + CALL ADI_PackInflowWindData( Re_Buf, Db_Buf, Int_Buf, InData%IW, ErrStat2, ErrMsg2, OnlySize ) ! IW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3162,7 +3086,7 @@ SUBROUTINE ADI_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%VTK_surfaces,1), UBOUND(InData%VTK_surfaces,1) - CALL AD_Packvtk_rotsurfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surfaces(i1), ErrStat2, ErrMsg2, OnlySize ) ! VTK_surfaces + CALL AD_PackVTK_RotSurfaceType( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surfaces(i1), ErrStat2, ErrMsg2, OnlySize ) ! VTK_surfaces CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3294,7 +3218,7 @@ SUBROUTINE ADI_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ADI_Unpackinflowwinddata( Re_Buf, Db_Buf, Int_Buf, OutData%IW, ErrStat2, ErrMsg2 ) ! IW + CALL ADI_UnpackInflowWindData( Re_Buf, Db_Buf, Int_Buf, OutData%IW, ErrStat2, ErrMsg2 ) ! IW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3348,7 +3272,7 @@ SUBROUTINE ADI_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Unpackvtk_rotsurfacetype( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_surfaces(i1), ErrStat2, ErrMsg2 ) ! VTK_surfaces + CALL AD_UnpackVTK_RotSurfaceType( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_surfaces(i1), ErrStat2, ErrMsg2 ) ! VTK_surfaces CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3385,14 +3309,12 @@ SUBROUTINE ADI_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WtrDpth = SrcParamData%WtrDpth END SUBROUTINE ADI_CopyParam - SUBROUTINE ADI_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ADI_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(ADI_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyParam' @@ -3400,13 +3322,7 @@ SUBROUTINE ADI_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_DestroyParam( ParamData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyParam( ParamData%AD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE ADI_DestroyParam @@ -3642,14 +3558,12 @@ SUBROUTINE ADI_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE ADI_CopyInput - SUBROUTINE ADI_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ADI_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(ADI_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyInput' @@ -3657,13 +3571,7 @@ SUBROUTINE ADI_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_DestroyInput( InputData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyInput( InputData%AD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE ADI_DestroyInput @@ -3905,14 +3813,12 @@ SUBROUTINE ADI_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM ENDIF END SUBROUTINE ADI_CopyOutput - SUBROUTINE ADI_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ADI_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(ADI_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyOutput' @@ -3920,13 +3826,7 @@ SUBROUTINE ADI_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD_DestroyOutput( OutputData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyOutput( OutputData%AD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(OutputData%HHVel)) THEN DEALLOCATE(OutputData%HHVel) @@ -4366,14 +4266,12 @@ SUBROUTINE ADI_CopyData( SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE ADI_CopyData - SUBROUTINE ADI_DestroyData( DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ADI_DestroyData( DataData, ErrStat, ErrMsg ) TYPE(ADI_Data), INTENT(INOUT) :: DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyData' @@ -4381,52 +4279,46 @@ SUBROUTINE ADI_DestroyData( DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(DataData%x)) THEN DO i1 = LBOUND(DataData%x,1), UBOUND(DataData%x,1) - CALL ADI_DestroyContState( DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ADI_DestroyContState( DataData%x(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(DataData%x) ENDIF IF (ALLOCATED(DataData%xd)) THEN DO i1 = LBOUND(DataData%xd,1), UBOUND(DataData%xd,1) - CALL ADI_DestroyDiscState( DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ADI_DestroyDiscState( DataData%xd(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(DataData%xd) ENDIF IF (ALLOCATED(DataData%z)) THEN DO i1 = LBOUND(DataData%z,1), UBOUND(DataData%z,1) - CALL ADI_DestroyConstrState( DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ADI_DestroyConstrState( DataData%z(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(DataData%z) ENDIF IF (ALLOCATED(DataData%OtherState)) THEN DO i1 = LBOUND(DataData%OtherState,1), UBOUND(DataData%OtherState,1) - CALL ADI_DestroyOtherState( DataData%OtherState(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ADI_DestroyOtherState( DataData%OtherState(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(DataData%OtherState) ENDIF - CALL ADI_DestroyParam( DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ADI_DestroyParam( DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_DestroyMisc( DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ADI_DestroyMisc( DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(DataData%u)) THEN DO i1 = LBOUND(DataData%u,1), UBOUND(DataData%u,1) - CALL ADI_DestroyInput( DataData%u(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ADI_DestroyInput( DataData%u(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(DataData%u) ENDIF - CALL ADI_DestroyOutput( DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ADI_DestroyOutput( DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(DataData%inputTimes)) THEN DEALLOCATE(DataData%inputTimes) @@ -5534,14 +5426,12 @@ SUBROUTINE ADI_CopyRotFED( SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrM IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE ADI_CopyRotFED - SUBROUTINE ADI_DestroyRotFED( RotFEDData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ADI_DestroyRotFED( RotFEDData, ErrStat, ErrMsg ) TYPE(RotFED), INTENT(INOUT) :: RotFEDData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyRotFED' @@ -5549,12 +5439,6 @@ SUBROUTINE ADI_DestroyRotFED( RotFEDData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( RotFEDData%PlatformPtMesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL MeshDestroy( RotFEDData%TwrPtMesh, ErrStat2, ErrMsg2 ) @@ -5579,29 +5463,29 @@ SUBROUTINE ADI_DestroyRotFED( RotFEDData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDDO DEALLOCATE(RotFEDData%BladeLn2Mesh) ENDIF - CALL NWTC_Library_Destroymeshmaptype( RotFEDData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( RotFEDData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( RotFEDData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( RotFEDData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(RotFEDData%AD_P_2_AD_L_B)) THEN DO i1 = LBOUND(RotFEDData%AD_P_2_AD_L_B,1), UBOUND(RotFEDData%AD_P_2_AD_L_B,1) - CALL NWTC_Library_Destroymeshmaptype( RotFEDData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( RotFEDData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(RotFEDData%AD_P_2_AD_L_B) ENDIF - CALL NWTC_Library_Destroymeshmaptype( RotFEDData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( RotFEDData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(RotFEDData%ED_P_2_AD_P_R)) THEN DO i1 = LBOUND(RotFEDData%ED_P_2_AD_P_R,1), UBOUND(RotFEDData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_Destroymeshmaptype( RotFEDData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( RotFEDData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(RotFEDData%ED_P_2_AD_P_R) ENDIF - CALL NWTC_Library_Destroymeshmaptype( RotFEDData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( RotFEDData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( RotFEDData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( RotFEDData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE ADI_DestroyRotFED @@ -5776,7 +5660,7 @@ SUBROUTINE ADI_PackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 1 ! rigidBlades Int_BufSz = Int_BufSz + 1 ! numBlades Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_T + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5793,7 +5677,7 @@ SUBROUTINE ADI_PackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! AD_P_2_AD_L_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_AD_L_T + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_AD_L_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5814,7 +5698,7 @@ SUBROUTINE ADI_PackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 2*1 ! AD_P_2_AD_L_B upper/lower bounds for each dimension DO i1 = LBOUND(InData%AD_P_2_AD_L_B,1), UBOUND(InData%AD_P_2_AD_L_B,1) Int_BufSz = Int_BufSz + 3 ! AD_P_2_AD_L_B: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_AD_L_B + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_AD_L_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5833,7 +5717,7 @@ SUBROUTINE ADI_PackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, END DO END IF Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_TF: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_TF + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_TF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5854,7 +5738,7 @@ SUBROUTINE ADI_PackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_AD_P_R upper/lower bounds for each dimension DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_R: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_R + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_R CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5873,7 +5757,7 @@ SUBROUTINE ADI_PackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, END DO END IF Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_H: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_H + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_H CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5890,7 +5774,7 @@ SUBROUTINE ADI_PackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_N + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6161,7 +6045,7 @@ SUBROUTINE ADI_PackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%numBlades Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_T + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6189,7 +6073,7 @@ SUBROUTINE ADI_PackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_AD_L_T + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_AD_L_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6228,7 +6112,7 @@ SUBROUTINE ADI_PackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%AD_P_2_AD_L_B,1), UBOUND(InData%AD_P_2_AD_L_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_AD_L_B + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_AD_L_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6258,7 +6142,7 @@ SUBROUTINE ADI_PackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ENDIF END DO END IF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_TF + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_TF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6297,7 +6181,7 @@ SUBROUTINE ADI_PackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_R + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_R CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6327,7 +6211,7 @@ SUBROUTINE ADI_PackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ENDIF END DO END IF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_H + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_H CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6355,7 +6239,7 @@ SUBROUTINE ADI_PackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_N + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6763,7 +6647,7 @@ SUBROUTINE ADI_UnPackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_T + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6803,7 +6687,7 @@ SUBROUTINE ADI_UnPackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2 ) ! AD_P_2_AD_L_T + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2 ) ! AD_P_2_AD_L_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6857,7 +6741,7 @@ SUBROUTINE ADI_UnPackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) ! AD_P_2_AD_L_B + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) ! AD_P_2_AD_L_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6899,7 +6783,7 @@ SUBROUTINE ADI_UnPackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_TF + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_TF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6953,7 +6837,7 @@ SUBROUTINE ADI_UnPackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_R + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_R CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6995,7 +6879,7 @@ SUBROUTINE ADI_UnPackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_H + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_H CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7035,7 +6919,7 @@ SUBROUTINE ADI_UnPackRotFED( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_N + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7077,14 +6961,12 @@ SUBROUTINE ADI_CopyFED_Data( SrcFED_DataData, DstFED_DataData, CtrlCode, ErrStat ENDIF END SUBROUTINE ADI_CopyFED_Data - SUBROUTINE ADI_DestroyFED_Data( FED_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ADI_DestroyFED_Data( FED_DataData, ErrStat, ErrMsg ) TYPE(FED_Data), INTENT(INOUT) :: FED_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyFED_Data' @@ -7092,15 +6974,9 @@ SUBROUTINE ADI_DestroyFED_Data( FED_DataData, ErrStat, ErrMsg, DEALLOCATEpointer ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(FED_DataData%WT)) THEN DO i1 = LBOUND(FED_DataData%WT,1), UBOUND(FED_DataData%WT,1) - CALL ADI_Destroyrotfed( FED_DataData%WT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ADI_DestroyRotFED( FED_DataData%WT(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(FED_DataData%WT) @@ -7148,7 +7024,7 @@ SUBROUTINE ADI_PackFED_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%WT,1), UBOUND(InData%WT,1) Int_BufSz = Int_BufSz + 3 ! WT: size of buffers for each call to pack subtype - CALL ADI_Packrotfed( Re_Buf, Db_Buf, Int_Buf, InData%WT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WT + CALL ADI_PackRotFED( Re_Buf, Db_Buf, Int_Buf, InData%WT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WT CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7204,7 +7080,7 @@ SUBROUTINE ADI_PackFED_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%WT,1), UBOUND(InData%WT,1) - CALL ADI_Packrotfed( Re_Buf, Db_Buf, Int_Buf, InData%WT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WT + CALL ADI_PackRotFED( Re_Buf, Db_Buf, Int_Buf, InData%WT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WT CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7310,7 +7186,7 @@ SUBROUTINE ADI_UnPackFED_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ADI_Unpackrotfed( Re_Buf, Db_Buf, Int_Buf, OutData%WT(i1), ErrStat2, ErrMsg2 ) ! WT + CALL ADI_UnpackRotFED( Re_Buf, Db_Buf, Int_Buf, OutData%WT(i1), ErrStat2, ErrMsg2 ) ! WT CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 441e24f6a1..e825d23a0b 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -316,7 +316,7 @@ typedef ^ RotMiscVarType ReKi TFinSTV_i 3 - - "Structural velocity at the refer typedef ^ RotMiscVarType ReKi TFinF_i 3 - - "Forces at the reference point of the fin in the inertial system" typedef ^ RotMiscVarType ReKi TFinM_i 3 - - "Moments at the reference point of the fin in the inertial system" -typedef ^ MiscVarType RotMiscVarType rotors {:}- - - "MiscVars for each rotor" - +typedef ^ MiscVarType RotMiscVarType rotors {:} - - - "MiscVars for each rotor" - typedef ^ MiscVarType FVW_InputType FVW_u : - - "Inputs to the FVW module" - typedef ^ MiscVarType FVW_OutputType FVW_y - - - "Outputs from the FVW module" - typedef ^ MiscVarType FVW_MiscVarType FVW - - - "MiscVars from the FVW module" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 77135b3b37..5fea2c2ce3 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -31,7 +31,7 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE AeroDyn_Types !--------------------------------------------------------------------------------------------------------------------------------- -USE UnsteadyAero_Types +USE AirfoilInfo_Types USE BEMT_Types USE FVW_Types USE AeroAcoustics_Types @@ -188,7 +188,7 @@ MODULE AeroDyn_Types ! ========= AD_InputFile ======= TYPE, PUBLIC :: AD_InputFile LOGICAL :: Echo !< Echo input file to echo file [-] - REAL(DbKi) :: DTAero !< Time interval for aerodynamic calculations {or "default"} [s] + REAL(DbKi) :: DTAero !< Time interval for aerodynamic calculations {or [default"}"] INTEGER(IntKi) :: WakeMod !< Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW} [-] INTEGER(IntKi) :: AFAeroMod !< Type of blade airfoil aerodynamics model {1=steady model, 2=Beddoes-Leishman unsteady model} [-] INTEGER(IntKi) :: TwrPotent !< Type of tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] @@ -226,7 +226,7 @@ MODULE AeroDyn_Types CHARACTER(1024) :: FVWFileName !< FVW input filename [quoted string] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: AFNames !< Airfoil file names (NumAF lines) [quoted strings] LOGICAL :: UseBlCm !< Include aerodynamic pitching moment in calculations? [flag] - LOGICAL :: SumPrint !< Generate a summary file listing input options and interpolated properties to ".AD.sum"? [flag] + LOGICAL :: SumPrint !< Generate a summary file listing input options and interpolated properties to [.AD.sum"?"] INTEGER(IntKi) :: NBlOuts !< Number of blade node outputs [0 - 9] [-] INTEGER(IntKi) , DIMENSION(1:9) :: BlOutNd !< Blade nodes whose values will be output [-] INTEGER(IntKi) :: NTwOuts !< Number of tower node outputs [0 - 9] [-] @@ -358,7 +358,7 @@ MODULE AeroDyn_Types ! ======================= ! ========= AD_MiscVarType ======= TYPE, PUBLIC :: AD_MiscVarType - TYPE(RotMiscVarType) , DIMENSION(:), ALLOCATABLE :: rotors !< MiscVars for each rotor [-] + TYPE(RotMiscVarType) , DIMENSION(:), ALLOCATABLE :: rotors !< - [MiscVars for each rotor] TYPE(FVW_InputType) , DIMENSION(:), ALLOCATABLE :: FVW_u !< Inputs to the FVW module [-] TYPE(FVW_OutputType) :: FVW_y !< Outputs from the FVW module [-] TYPE(FVW_MiscVarType) :: FVW !< MiscVars from the FVW module [-] @@ -490,10 +490,6 @@ SUBROUTINE AD_CopyTFinParameterType( SrcTFinParameterTypeData, DstTFinParameterT CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyTFinParameterType' @@ -507,14 +503,12 @@ SUBROUTINE AD_CopyTFinParameterType( SrcTFinParameterTypeData, DstTFinParameterT DstTFinParameterTypeData%TFinAFID = SrcTFinParameterTypeData%TFinAFID END SUBROUTINE AD_CopyTFinParameterType - SUBROUTINE AD_DestroyTFinParameterType( TFinParameterTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyTFinParameterType( TFinParameterTypeData, ErrStat, ErrMsg ) TYPE(TFinParameterType), INTENT(INOUT) :: TFinParameterTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyTFinParameterType' @@ -522,12 +516,6 @@ SUBROUTINE AD_DestroyTFinParameterType( TFinParameterTypeData, ErrStat, ErrMsg, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AD_DestroyTFinParameterType SUBROUTINE AD_PackTFinParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -622,10 +610,6 @@ SUBROUTINE AD_UnPackTFinParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackTFinParameterType' @@ -675,14 +659,12 @@ SUBROUTINE AD_CopyTFinInputFileType( SrcTFinInputFileTypeData, DstTFinInputFileT DstTFinInputFileTypeData%TFinAFID = SrcTFinInputFileTypeData%TFinAFID END SUBROUTINE AD_CopyTFinInputFileType - SUBROUTINE AD_DestroyTFinInputFileType( TFinInputFileTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyTFinInputFileType( TFinInputFileTypeData, ErrStat, ErrMsg ) TYPE(TFinInputFileType), INTENT(INOUT) :: TFinInputFileTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyTFinInputFileType' @@ -690,12 +672,6 @@ SUBROUTINE AD_DestroyTFinInputFileType( TFinInputFileTypeData, ErrStat, ErrMsg, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AD_DestroyTFinInputFileType SUBROUTINE AD_PackTFinInputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -873,14 +849,12 @@ SUBROUTINE AD_CopyVTK_BLSurfaceType( SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceT ENDIF END SUBROUTINE AD_CopyVTK_BLSurfaceType - SUBROUTINE AD_DestroyVTK_BLSurfaceType( VTK_BLSurfaceTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyVTK_BLSurfaceType( VTK_BLSurfaceTypeData, ErrStat, ErrMsg ) TYPE(AD_VTK_BLSurfaceType), INTENT(INOUT) :: VTK_BLSurfaceTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyVTK_BLSurfaceType' @@ -888,12 +862,6 @@ SUBROUTINE AD_DestroyVTK_BLSurfaceType( VTK_BLSurfaceTypeData, ErrStat, ErrMsg, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(VTK_BLSurfaceTypeData%AirfoilCoords)) THEN DEALLOCATE(VTK_BLSurfaceTypeData%AirfoilCoords) ENDIF @@ -1097,14 +1065,12 @@ SUBROUTINE AD_CopyVTK_RotSurfaceType( SrcVTK_RotSurfaceTypeData, DstVTK_RotSurfa ENDIF END SUBROUTINE AD_CopyVTK_RotSurfaceType - SUBROUTINE AD_DestroyVTK_RotSurfaceType( VTK_RotSurfaceTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyVTK_RotSurfaceType( VTK_RotSurfaceTypeData, ErrStat, ErrMsg ) TYPE(AD_VTK_RotSurfaceType), INTENT(INOUT) :: VTK_RotSurfaceTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyVTK_RotSurfaceType' @@ -1112,15 +1078,9 @@ SUBROUTINE AD_DestroyVTK_RotSurfaceType( VTK_RotSurfaceTypeData, ErrStat, ErrMsg ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(VTK_RotSurfaceTypeData%BladeShape)) THEN DO i1 = LBOUND(VTK_RotSurfaceTypeData%BladeShape,1), UBOUND(VTK_RotSurfaceTypeData%BladeShape,1) - CALL AD_Destroyvtk_blsurfacetype( VTK_RotSurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyVTK_BLSurfaceType( VTK_RotSurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(VTK_RotSurfaceTypeData%BladeShape) @@ -1171,7 +1131,7 @@ SUBROUTINE AD_PackVTK_RotSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) Int_BufSz = Int_BufSz + 3 ! BladeShape: size of buffers for each call to pack subtype - CALL AD_Packvtk_blsurfacetype( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeShape + CALL AD_PackVTK_BLSurfaceType( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeShape CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1232,7 +1192,7 @@ SUBROUTINE AD_PackVTK_RotSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) - CALL AD_Packvtk_blsurfacetype( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeShape + CALL AD_PackVTK_BLSurfaceType( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeShape CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1353,7 +1313,7 @@ SUBROUTINE AD_UnPackVTK_RotSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Unpackvtk_blsurfacetype( Re_Buf, Db_Buf, Int_Buf, OutData%BladeShape(i1), ErrStat2, ErrMsg2 ) ! BladeShape + CALL AD_UnpackVTK_BLSurfaceType( Re_Buf, Db_Buf, Int_Buf, OutData%BladeShape(i1), ErrStat2, ErrMsg2 ) ! BladeShape CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1438,14 +1398,12 @@ SUBROUTINE AD_CopyRotInitInputType( SrcRotInitInputTypeData, DstRotInitInputType DstRotInitInputTypeData%AeroBEM_Mod = SrcRotInitInputTypeData%AeroBEM_Mod END SUBROUTINE AD_CopyRotInitInputType - SUBROUTINE AD_DestroyRotInitInputType( RotInitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyRotInitInputType( RotInitInputTypeData, ErrStat, ErrMsg ) TYPE(RotInitInputType), INTENT(INOUT) :: RotInitInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotInitInputType' @@ -1453,12 +1411,6 @@ SUBROUTINE AD_DestroyRotInitInputType( RotInitInputTypeData, ErrStat, ErrMsg, DE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(RotInitInputTypeData%BladeRootPosition)) THEN DEALLOCATE(RotInitInputTypeData%BladeRootPosition) ENDIF @@ -1788,14 +1740,12 @@ SUBROUTINE AD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL END SUBROUTINE AD_CopyInitInput - SUBROUTINE AD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(AD_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyInitInput' @@ -1803,20 +1753,14 @@ SUBROUTINE AD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%rotors)) THEN DO i1 = LBOUND(InitInputData%rotors,1), UBOUND(InitInputData%rotors,1) - CALL AD_Destroyrotinitinputtype( InitInputData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyRotInitInputType( InitInputData%rotors(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InitInputData%rotors) ENDIF - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyInitInput @@ -1861,7 +1805,7 @@ SUBROUTINE AD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotinitinputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors + CALL AD_PackRotInitInputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1883,7 +1827,7 @@ SUBROUTINE AD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName Int_BufSz = Int_BufSz + 1 ! UsePrimaryInputFile Int_BufSz = Int_BufSz + 3 ! PassedPrimaryInputData: size of buffers for each call to pack subtype - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedPrimaryInputData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedPrimaryInputData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1947,7 +1891,7 @@ SUBROUTINE AD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotinitinputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors + CALL AD_PackRotInitInputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1987,7 +1931,7 @@ SUBROUTINE AD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg END DO ! I IntKiBuf(Int_Xferred) = TRANSFER(InData%UsePrimaryInputFile, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, OnlySize ) ! PassedPrimaryInputData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, OnlySize ) ! PassedPrimaryInputData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2111,7 +2055,7 @@ SUBROUTINE AD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Unpackrotinitinputtype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors + CALL AD_UnpackRotInitInputType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2163,7 +2107,7 @@ SUBROUTINE AD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackfileinfotype( Re_Buf, Db_Buf, Int_Buf, OutData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) ! PassedPrimaryInputData + CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) ! PassedPrimaryInputData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2330,14 +2274,12 @@ SUBROUTINE AD_CopyBladePropsType( SrcBladePropsTypeData, DstBladePropsTypeData, ENDIF END SUBROUTINE AD_CopyBladePropsType - SUBROUTINE AD_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg ) TYPE(AD_BladePropsType), INTENT(INOUT) :: BladePropsTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyBladePropsType' @@ -2345,12 +2287,6 @@ SUBROUTINE AD_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(BladePropsTypeData%BlSpn)) THEN DEALLOCATE(BladePropsTypeData%BlSpn) ENDIF @@ -2896,14 +2832,12 @@ SUBROUTINE AD_CopyBladeShape( SrcBladeShapeData, DstBladeShapeData, CtrlCode, Er ENDIF END SUBROUTINE AD_CopyBladeShape - SUBROUTINE AD_DestroyBladeShape( BladeShapeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyBladeShape( BladeShapeData, ErrStat, ErrMsg ) TYPE(AD_BladeShape), INTENT(INOUT) :: BladeShapeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyBladeShape' @@ -2911,12 +2845,6 @@ SUBROUTINE AD_DestroyBladeShape( BladeShapeData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(BladeShapeData%AirfoilCoords)) THEN DEALLOCATE(BladeShapeData%AirfoilCoords) ENDIF @@ -3269,14 +3197,12 @@ SUBROUTINE AD_CopyRotInitOutputType( SrcRotInitOutputTypeData, DstRotInitOutputT ENDIF END SUBROUTINE AD_CopyRotInitOutputType - SUBROUTINE AD_DestroyRotInitOutputType( RotInitOutputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyRotInitOutputType( RotInitOutputTypeData, ErrStat, ErrMsg ) TYPE(RotInitOutputType), INTENT(INOUT) :: RotInitOutputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotInitOutputType' @@ -3284,12 +3210,6 @@ SUBROUTINE AD_DestroyRotInitOutputType( RotInitOutputTypeData, ErrStat, ErrMsg, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(RotInitOutputTypeData%WriteOutputHdr)) THEN DEALLOCATE(RotInitOutputTypeData%WriteOutputHdr) ENDIF @@ -3298,7 +3218,7 @@ SUBROUTINE AD_DestroyRotInitOutputType( RotInitOutputTypeData, ErrStat, ErrMsg, ENDIF IF (ALLOCATED(RotInitOutputTypeData%BladeShape)) THEN DO i1 = LBOUND(RotInitOutputTypeData%BladeShape,1), UBOUND(RotInitOutputTypeData%BladeShape,1) - CALL AD_Destroybladeshape( RotInitOutputTypeData%BladeShape(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyBladeShape( RotInitOutputTypeData%BladeShape(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(RotInitOutputTypeData%BladeShape) @@ -3326,7 +3246,7 @@ SUBROUTINE AD_DestroyRotInitOutputType( RotInitOutputTypeData, ErrStat, ErrMsg, ENDIF IF (ALLOCATED(RotInitOutputTypeData%BladeProps)) THEN DO i1 = LBOUND(RotInitOutputTypeData%BladeProps,1), UBOUND(RotInitOutputTypeData%BladeProps,1) - CALL AD_Destroybladepropstype( RotInitOutputTypeData%BladeProps(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyBladePropsType( RotInitOutputTypeData%BladeProps(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(RotInitOutputTypeData%BladeProps) @@ -3394,7 +3314,7 @@ SUBROUTINE AD_PackRotInitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) Int_BufSz = Int_BufSz + 3 ! BladeShape: size of buffers for each call to pack subtype - CALL AD_Packbladeshape( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeShape + CALL AD_PackBladeShape( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeShape CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3452,7 +3372,7 @@ SUBROUTINE AD_PackRotInitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Int_BufSz = Int_BufSz + 2*1 ! BladeProps upper/lower bounds for each dimension DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) Int_BufSz = Int_BufSz + 3 ! BladeProps: size of buffers for each call to pack subtype - CALL AD_Packbladepropstype( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeProps + CALL AD_PackBladePropsType( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeProps CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3559,7 +3479,7 @@ SUBROUTINE AD_PackRotInitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) - CALL AD_Packbladeshape( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeShape + CALL AD_PackBladeShape( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeShape CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3711,7 +3631,7 @@ SUBROUTINE AD_PackRotInitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) - CALL AD_Packbladepropstype( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeProps + CALL AD_PackBladePropsType( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeProps CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3904,7 +3824,7 @@ SUBROUTINE AD_UnPackRotInitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Unpackbladeshape( Re_Buf, Db_Buf, Int_Buf, OutData%BladeShape(i1), ErrStat2, ErrMsg2 ) ! BladeShape + CALL AD_UnpackBladeShape( Re_Buf, Db_Buf, Int_Buf, OutData%BladeShape(i1), ErrStat2, ErrMsg2 ) ! BladeShape CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4092,7 +4012,7 @@ SUBROUTINE AD_UnPackRotInitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Unpackbladepropstype( Re_Buf, Db_Buf, Int_Buf, OutData%BladeProps(i1), ErrStat2, ErrMsg2 ) ! BladeProps + CALL AD_UnpackBladePropsType( Re_Buf, Db_Buf, Int_Buf, OutData%BladeProps(i1), ErrStat2, ErrMsg2 ) ! BladeProps CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4193,14 +4113,12 @@ SUBROUTINE AD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyInitOutput - SUBROUTINE AD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(AD_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyInitOutput' @@ -4208,20 +4126,14 @@ SUBROUTINE AD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%rotors)) THEN DO i1 = LBOUND(InitOutputData%rotors,1), UBOUND(InitOutputData%rotors,1) - CALL AD_Destroyrotinitoutputtype( InitOutputData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyRotInitOutputType( InitOutputData%rotors(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InitOutputData%rotors) ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyInitOutput @@ -4266,7 +4178,7 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotinitoutputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors + CALL AD_PackRotInitOutputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4285,7 +4197,7 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END DO END IF Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4339,7 +4251,7 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotinitoutputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors + CALL AD_PackRotInitOutputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4369,7 +4281,7 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ENDIF END DO END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4473,7 +4385,7 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Unpackrotinitoutputtype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors + CALL AD_UnpackRotInitOutputType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4515,7 +4427,7 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4627,14 +4539,12 @@ SUBROUTINE AD_CopyRotInputFile( SrcRotInputFileData, DstRotInputFileData, CtrlCo IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyRotInputFile - SUBROUTINE AD_DestroyRotInputFile( RotInputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyRotInputFile( RotInputFileData, ErrStat, ErrMsg ) TYPE(RotInputFile), INTENT(INOUT) :: RotInputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotInputFile' @@ -4642,15 +4552,9 @@ SUBROUTINE AD_DestroyRotInputFile( RotInputFileData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(RotInputFileData%BladeProps)) THEN DO i1 = LBOUND(RotInputFileData%BladeProps,1), UBOUND(RotInputFileData%BladeProps,1) - CALL AD_Destroybladepropstype( RotInputFileData%BladeProps(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyBladePropsType( RotInputFileData%BladeProps(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(RotInputFileData%BladeProps) @@ -4670,7 +4574,7 @@ SUBROUTINE AD_DestroyRotInputFile( RotInputFileData, ErrStat, ErrMsg, DEALLOCATE IF (ALLOCATED(RotInputFileData%TwrCb)) THEN DEALLOCATE(RotInputFileData%TwrCb) ENDIF - CALL AD_Destroytfininputfiletype( RotInputFileData%TFin, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyTFinInputFileType( RotInputFileData%TFin, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyRotInputFile @@ -4715,7 +4619,7 @@ SUBROUTINE AD_PackRotInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) Int_BufSz = Int_BufSz + 3 ! BladeProps: size of buffers for each call to pack subtype - CALL AD_Packbladepropstype( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeProps + CALL AD_PackBladePropsType( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeProps CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4766,7 +4670,7 @@ SUBROUTINE AD_PackRotInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_BufSz = Int_BufSz + 1 ! TFinAero Int_BufSz = Int_BufSz + 1*LEN(InData%TFinFile) ! TFinFile Int_BufSz = Int_BufSz + 3 ! TFin: size of buffers for each call to pack subtype - CALL AD_Packtfininputfiletype( Re_Buf, Db_Buf, Int_Buf, InData%TFin, ErrStat2, ErrMsg2, .TRUE. ) ! TFin + CALL AD_PackTFinInputFileType( Re_Buf, Db_Buf, Int_Buf, InData%TFin, ErrStat2, ErrMsg2, .TRUE. ) ! TFin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4820,7 +4724,7 @@ SUBROUTINE AD_PackRotInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) - CALL AD_Packbladepropstype( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeProps + CALL AD_PackBladePropsType( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeProps CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4943,7 +4847,7 @@ SUBROUTINE AD_PackRotInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf(Int_Xferred) = ICHAR(InData%TFinFile(I:I), IntKi) Int_Xferred = Int_Xferred + 1 END DO ! I - CALL AD_Packtfininputfiletype( Re_Buf, Db_Buf, Int_Buf, InData%TFin, ErrStat2, ErrMsg2, OnlySize ) ! TFin + CALL AD_PackTFinInputFileType( Re_Buf, Db_Buf, Int_Buf, InData%TFin, ErrStat2, ErrMsg2, OnlySize ) ! TFin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5047,7 +4951,7 @@ SUBROUTINE AD_UnPackRotInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Unpackbladepropstype( Re_Buf, Db_Buf, Int_Buf, OutData%BladeProps(i1), ErrStat2, ErrMsg2 ) ! BladeProps + CALL AD_UnpackBladePropsType( Re_Buf, Db_Buf, Int_Buf, OutData%BladeProps(i1), ErrStat2, ErrMsg2 ) ! BladeProps CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5199,7 +5103,7 @@ SUBROUTINE AD_UnPackRotInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Unpacktfininputfiletype( Re_Buf, Db_Buf, Int_Buf, OutData%TFin, ErrStat2, ErrMsg2 ) ! TFin + CALL AD_UnpackTFinInputFileType( Re_Buf, Db_Buf, Int_Buf, OutData%TFin, ErrStat2, ErrMsg2 ) ! TFin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5339,14 +5243,12 @@ SUBROUTINE AD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt ENDIF END SUBROUTINE AD_CopyInputFile - SUBROUTINE AD_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) TYPE(AD_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyInputFile' @@ -5354,12 +5256,6 @@ SUBROUTINE AD_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputFileData%ADBlFile)) THEN DEALLOCATE(InputFileData%ADBlFile) ENDIF @@ -5374,7 +5270,7 @@ SUBROUTINE AD_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointe ENDIF IF (ALLOCATED(InputFileData%rotors)) THEN DO i1 = LBOUND(InputFileData%rotors,1), UBOUND(InputFileData%rotors,1) - CALL AD_Destroyrotinputfile( InputFileData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyRotInputFile( InputFileData%rotors(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InputFileData%rotors) @@ -5492,7 +5388,7 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotinputfile( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors + CALL AD_PackRotInputFile( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5726,7 +5622,7 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotinputfile( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors + CALL AD_PackRotInputFile( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6026,7 +5922,7 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Unpackrotinputfile( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors + CALL AD_UnpackRotInputFile( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6059,14 +5955,12 @@ SUBROUTINE AD_CopyRotContinuousStateType( SrcRotContinuousStateTypeData, DstRotC IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyRotContinuousStateType - SUBROUTINE AD_DestroyRotContinuousStateType( RotContinuousStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyRotContinuousStateType( RotContinuousStateTypeData, ErrStat, ErrMsg ) TYPE(RotContinuousStateType), INTENT(INOUT) :: RotContinuousStateTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotContinuousStateType' @@ -6074,15 +5968,9 @@ SUBROUTINE AD_DestroyRotContinuousStateType( RotContinuousStateTypeData, ErrStat ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL BEMT_DestroyContState( RotContinuousStateTypeData%BEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BEMT_DestroyContState( RotContinuousStateTypeData%BEMT, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyContState( RotContinuousStateTypeData%AA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AA_DestroyContState( RotContinuousStateTypeData%AA, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyRotContinuousStateType @@ -6385,14 +6273,12 @@ SUBROUTINE AD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrSt IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyContState - SUBROUTINE AD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(AD_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyContState' @@ -6400,20 +6286,14 @@ SUBROUTINE AD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ContStateData%rotors)) THEN DO i1 = LBOUND(ContStateData%rotors,1), UBOUND(ContStateData%rotors,1) - CALL AD_Destroyrotcontinuousstatetype( ContStateData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyRotContinuousStateType( ContStateData%rotors(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ContStateData%rotors) ENDIF - CALL FVW_DestroyContState( ContStateData%FVW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyContState( ContStateData%FVW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyContState @@ -6458,7 +6338,7 @@ SUBROUTINE AD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotcontinuousstatetype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors + CALL AD_PackRotContinuousStateType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6531,7 +6411,7 @@ SUBROUTINE AD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotcontinuousstatetype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors + CALL AD_PackRotContinuousStateType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6665,7 +6545,7 @@ SUBROUTINE AD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Unpackrotcontinuousstatetype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors + CALL AD_UnpackRotContinuousStateType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6738,14 +6618,12 @@ SUBROUTINE AD_CopyRotDiscreteStateType( SrcRotDiscreteStateTypeData, DstRotDiscr IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyRotDiscreteStateType - SUBROUTINE AD_DestroyRotDiscreteStateType( RotDiscreteStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyRotDiscreteStateType( RotDiscreteStateTypeData, ErrStat, ErrMsg ) TYPE(RotDiscreteStateType), INTENT(INOUT) :: RotDiscreteStateTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotDiscreteStateType' @@ -6753,15 +6631,9 @@ SUBROUTINE AD_DestroyRotDiscreteStateType( RotDiscreteStateTypeData, ErrStat, Er ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL BEMT_DestroyDiscState( RotDiscreteStateTypeData%BEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BEMT_DestroyDiscState( RotDiscreteStateTypeData%BEMT, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyDiscState( RotDiscreteStateTypeData%AA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AA_DestroyDiscState( RotDiscreteStateTypeData%AA, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyRotDiscreteStateType @@ -7064,14 +6936,12 @@ SUBROUTINE AD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyDiscState - SUBROUTINE AD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(AD_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyDiscState' @@ -7079,20 +6949,14 @@ SUBROUTINE AD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(DiscStateData%rotors)) THEN DO i1 = LBOUND(DiscStateData%rotors,1), UBOUND(DiscStateData%rotors,1) - CALL AD_Destroyrotdiscretestatetype( DiscStateData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyRotDiscreteStateType( DiscStateData%rotors(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(DiscStateData%rotors) ENDIF - CALL FVW_DestroyDiscState( DiscStateData%FVW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyDiscState( DiscStateData%FVW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyDiscState @@ -7137,7 +7001,7 @@ SUBROUTINE AD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotdiscretestatetype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors + CALL AD_PackRotDiscreteStateType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7210,7 +7074,7 @@ SUBROUTINE AD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotdiscretestatetype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors + CALL AD_PackRotDiscreteStateType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7344,7 +7208,7 @@ SUBROUTINE AD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Unpackrotdiscretestatetype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors + CALL AD_UnpackRotDiscreteStateType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7417,14 +7281,12 @@ SUBROUTINE AD_CopyRotConstraintStateType( SrcRotConstraintStateTypeData, DstRotC IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyRotConstraintStateType - SUBROUTINE AD_DestroyRotConstraintStateType( RotConstraintStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyRotConstraintStateType( RotConstraintStateTypeData, ErrStat, ErrMsg ) TYPE(RotConstraintStateType), INTENT(INOUT) :: RotConstraintStateTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotConstraintStateType' @@ -7432,15 +7294,9 @@ SUBROUTINE AD_DestroyRotConstraintStateType( RotConstraintStateTypeData, ErrStat ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL BEMT_DestroyConstrState( RotConstraintStateTypeData%BEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BEMT_DestroyConstrState( RotConstraintStateTypeData%BEMT, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyConstrState( RotConstraintStateTypeData%AA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AA_DestroyConstrState( RotConstraintStateTypeData%AA, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyRotConstraintStateType @@ -7743,14 +7599,12 @@ SUBROUTINE AD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyConstrState - SUBROUTINE AD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(AD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyConstrState' @@ -7758,20 +7612,14 @@ SUBROUTINE AD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ConstrStateData%rotors)) THEN DO i1 = LBOUND(ConstrStateData%rotors,1), UBOUND(ConstrStateData%rotors,1) - CALL AD_Destroyrotconstraintstatetype( ConstrStateData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyRotConstraintStateType( ConstrStateData%rotors(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ConstrStateData%rotors) ENDIF - CALL FVW_DestroyConstrState( ConstrStateData%FVW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyConstrState( ConstrStateData%FVW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyConstrState @@ -7816,7 +7664,7 @@ SUBROUTINE AD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotconstraintstatetype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors + CALL AD_PackRotConstraintStateType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7889,7 +7737,7 @@ SUBROUTINE AD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotconstraintstatetype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors + CALL AD_PackRotConstraintStateType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8023,7 +7871,7 @@ SUBROUTINE AD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Unpackrotconstraintstatetype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors + CALL AD_UnpackRotConstraintStateType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8096,14 +7944,12 @@ SUBROUTINE AD_CopyRotOtherStateType( SrcRotOtherStateTypeData, DstRotOtherStateT IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyRotOtherStateType - SUBROUTINE AD_DestroyRotOtherStateType( RotOtherStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyRotOtherStateType( RotOtherStateTypeData, ErrStat, ErrMsg ) TYPE(RotOtherStateType), INTENT(INOUT) :: RotOtherStateTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotOtherStateType' @@ -8111,15 +7957,9 @@ SUBROUTINE AD_DestroyRotOtherStateType( RotOtherStateTypeData, ErrStat, ErrMsg, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL BEMT_DestroyOtherState( RotOtherStateTypeData%BEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BEMT_DestroyOtherState( RotOtherStateTypeData%BEMT, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyOtherState( RotOtherStateTypeData%AA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AA_DestroyOtherState( RotOtherStateTypeData%AA, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyRotOtherStateType @@ -8437,14 +8277,12 @@ SUBROUTINE AD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, Er ENDIF END SUBROUTINE AD_CopyOtherState - SUBROUTINE AD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(AD_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyOtherState' @@ -8452,20 +8290,14 @@ SUBROUTINE AD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OtherStateData%rotors)) THEN DO i1 = LBOUND(OtherStateData%rotors,1), UBOUND(OtherStateData%rotors,1) - CALL AD_Destroyrototherstatetype( OtherStateData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyRotOtherStateType( OtherStateData%rotors(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OtherStateData%rotors) ENDIF - CALL FVW_DestroyOtherState( OtherStateData%FVW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyOtherState( OtherStateData%FVW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(OtherStateData%WakeLocationPoints)) THEN DEALLOCATE(OtherStateData%WakeLocationPoints) @@ -8513,7 +8345,7 @@ SUBROUTINE AD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrototherstatetype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors + CALL AD_PackRotOtherStateType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8591,7 +8423,7 @@ SUBROUTINE AD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrototherstatetype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors + CALL AD_PackRotOtherStateType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8746,7 +8578,7 @@ SUBROUTINE AD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Unpackrototherstatetype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors + CALL AD_UnpackRotOtherStateType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9354,14 +9186,12 @@ SUBROUTINE AD_CopyRotMiscVarType( SrcRotMiscVarTypeData, DstRotMiscVarTypeData, DstRotMiscVarTypeData%TFinM_i = SrcRotMiscVarTypeData%TFinM_i END SUBROUTINE AD_CopyRotMiscVarType - SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg ) TYPE(RotMiscVarType), INTENT(INOUT) :: RotMiscVarTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotMiscVarType' @@ -9369,25 +9199,19 @@ SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL BEMT_DestroyMisc( RotMiscVarTypeData%BEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BEMT_DestroyMisc( RotMiscVarTypeData%BEMT, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL BEMT_DestroyOutput( RotMiscVarTypeData%BEMT_y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BEMT_DestroyOutput( RotMiscVarTypeData%BEMT_y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) DO i1 = LBOUND(RotMiscVarTypeData%BEMT_u,1), UBOUND(RotMiscVarTypeData%BEMT_u,1) - CALL BEMT_DestroyInput( RotMiscVarTypeData%BEMT_u(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BEMT_DestroyInput( RotMiscVarTypeData%BEMT_u(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL AA_DestroyMisc( RotMiscVarTypeData%AA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AA_DestroyMisc( RotMiscVarTypeData%AA, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyOutput( RotMiscVarTypeData%AA_y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AA_DestroyOutput( RotMiscVarTypeData%AA_y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyInput( RotMiscVarTypeData%AA_u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AA_DestroyInput( RotMiscVarTypeData%AA_u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(RotMiscVarTypeData%DisturbedInflow)) THEN DEALLOCATE(RotMiscVarTypeData%DisturbedInflow) @@ -9441,7 +9265,7 @@ SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg, DEALLO CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(RotMiscVarTypeData%B_L_2_H_P)) THEN DO i1 = LBOUND(RotMiscVarTypeData%B_L_2_H_P,1), UBOUND(RotMiscVarTypeData%B_L_2_H_P,1) - CALL NWTC_Library_Destroymeshmaptype( RotMiscVarTypeData%B_L_2_H_P(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( RotMiscVarTypeData%B_L_2_H_P(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(RotMiscVarTypeData%B_L_2_H_P) @@ -9488,7 +9312,7 @@ SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg, DEALLO ENDIF IF (ALLOCATED(RotMiscVarTypeData%B_L_2_R_P)) THEN DO i1 = LBOUND(RotMiscVarTypeData%B_L_2_R_P,1), UBOUND(RotMiscVarTypeData%B_L_2_R_P,1) - CALL NWTC_Library_Destroymeshmaptype( RotMiscVarTypeData%B_L_2_R_P(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( RotMiscVarTypeData%B_L_2_R_P(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(RotMiscVarTypeData%B_L_2_R_P) @@ -9509,7 +9333,7 @@ SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg, DEALLO ENDIF IF (ALLOCATED(RotMiscVarTypeData%B_P_2_B_L)) THEN DO i1 = LBOUND(RotMiscVarTypeData%B_P_2_B_L,1), UBOUND(RotMiscVarTypeData%B_P_2_B_L,1) - CALL NWTC_Library_Destroymeshmaptype( RotMiscVarTypeData%B_P_2_B_L(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( RotMiscVarTypeData%B_P_2_B_L(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(RotMiscVarTypeData%B_P_2_B_L) @@ -9518,7 +9342,7 @@ SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg, DEALLO CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL MeshDestroy( RotMiscVarTypeData%TwrBuoyLoad, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( RotMiscVarTypeData%T_P_2_T_L, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( RotMiscVarTypeData%T_P_2_T_L, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyRotMiscVarType @@ -9768,7 +9592,7 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! B_L_2_H_P upper/lower bounds for each dimension DO i1 = LBOUND(InData%B_L_2_H_P,1), UBOUND(InData%B_L_2_H_P,1) Int_BufSz = Int_BufSz + 3 ! B_L_2_H_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%B_L_2_H_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! B_L_2_H_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%B_L_2_H_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! B_L_2_H_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9869,7 +9693,7 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! B_L_2_R_P upper/lower bounds for each dimension DO i1 = LBOUND(InData%B_L_2_R_P,1), UBOUND(InData%B_L_2_R_P,1) Int_BufSz = Int_BufSz + 3 ! B_L_2_R_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%B_L_2_R_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! B_L_2_R_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%B_L_2_R_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! B_L_2_R_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9938,7 +9762,7 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! B_P_2_B_L upper/lower bounds for each dimension DO i1 = LBOUND(InData%B_P_2_B_L,1), UBOUND(InData%B_P_2_B_L,1) Int_BufSz = Int_BufSz + 3 ! B_P_2_B_L: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%B_P_2_B_L(i1), ErrStat2, ErrMsg2, .TRUE. ) ! B_P_2_B_L + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%B_P_2_B_L(i1), ErrStat2, ErrMsg2, .TRUE. ) ! B_P_2_B_L CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9991,7 +9815,7 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! T_P_2_T_L: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%T_P_2_T_L, ErrStat2, ErrMsg2, .TRUE. ) ! T_P_2_T_L + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%T_P_2_T_L, ErrStat2, ErrMsg2, .TRUE. ) ! T_P_2_T_L CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10575,7 +10399,7 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%B_L_2_H_P,1), UBOUND(InData%B_L_2_H_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%B_L_2_H_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! B_L_2_H_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%B_L_2_H_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! B_L_2_H_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10867,7 +10691,7 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%B_L_2_R_P,1), UBOUND(InData%B_L_2_R_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%B_L_2_R_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! B_L_2_R_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%B_L_2_R_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! B_L_2_R_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10990,7 +10814,7 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%B_P_2_B_L,1), UBOUND(InData%B_P_2_B_L,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%B_P_2_B_L(i1), ErrStat2, ErrMsg2, OnlySize ) ! B_P_2_B_L + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%B_P_2_B_L(i1), ErrStat2, ErrMsg2, OnlySize ) ! B_P_2_B_L CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11076,7 +10900,7 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%T_P_2_T_L, ErrStat2, ErrMsg2, OnlySize ) ! T_P_2_T_L + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%T_P_2_T_L, ErrStat2, ErrMsg2, OnlySize ) ! T_P_2_T_L CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11877,7 +11701,7 @@ SUBROUTINE AD_UnPackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%B_L_2_H_P(i1), ErrStat2, ErrMsg2 ) ! B_L_2_H_P + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%B_L_2_H_P(i1), ErrStat2, ErrMsg2 ) ! B_L_2_H_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12232,7 +12056,7 @@ SUBROUTINE AD_UnPackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%B_L_2_R_P(i1), ErrStat2, ErrMsg2 ) ! B_L_2_R_P + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%B_L_2_R_P(i1), ErrStat2, ErrMsg2 ) ! B_L_2_R_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12400,7 +12224,7 @@ SUBROUTINE AD_UnPackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%B_P_2_B_L(i1), ErrStat2, ErrMsg2 ) ! B_P_2_B_L + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%B_P_2_B_L(i1), ErrStat2, ErrMsg2 ) ! B_P_2_B_L CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12522,7 +12346,7 @@ SUBROUTINE AD_UnPackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%T_P_2_T_L, ErrStat2, ErrMsg2 ) ! T_P_2_T_L + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%T_P_2_T_L, ErrStat2, ErrMsg2 ) ! T_P_2_T_L CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12642,14 +12466,12 @@ SUBROUTINE AD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyMisc - SUBROUTINE AD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(AD_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyMisc' @@ -12657,29 +12479,23 @@ SUBROUTINE AD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MiscData%rotors)) THEN DO i1 = LBOUND(MiscData%rotors,1), UBOUND(MiscData%rotors,1) - CALL AD_Destroyrotmiscvartype( MiscData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyRotMiscVarType( MiscData%rotors(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%rotors) ENDIF IF (ALLOCATED(MiscData%FVW_u)) THEN DO i1 = LBOUND(MiscData%FVW_u,1), UBOUND(MiscData%FVW_u,1) - CALL FVW_DestroyInput( MiscData%FVW_u(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyInput( MiscData%FVW_u(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%FVW_u) ENDIF - CALL FVW_DestroyOutput( MiscData%FVW_y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyOutput( MiscData%FVW_y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_DestroyMisc( MiscData%FVW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyMisc( MiscData%FVW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyMisc @@ -12724,7 +12540,7 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotmiscvartype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors + CALL AD_PackRotMiscVarType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12837,7 +12653,7 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotmiscvartype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors + CALL AD_PackRotMiscVarType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13040,7 +12856,7 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Unpackrotmiscvartype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors + CALL AD_UnpackRotMiscVarType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13529,14 +13345,12 @@ SUBROUTINE AD_CopyRotParameterType( SrcRotParameterTypeData, DstRotParameterType IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD_CopyRotParameterType - SUBROUTINE AD_DestroyRotParameterType( RotParameterTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyRotParameterType( RotParameterTypeData, ErrStat, ErrMsg ) TYPE(RotParameterType), INTENT(INOUT) :: RotParameterTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotParameterType' @@ -13544,12 +13358,6 @@ SUBROUTINE AD_DestroyRotParameterType( RotParameterTypeData, ErrStat, ErrMsg, DE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(RotParameterTypeData%TwrDiam)) THEN DEALLOCATE(RotParameterTypeData%TwrDiam) ENDIF @@ -13595,9 +13403,9 @@ SUBROUTINE AD_DestroyRotParameterType( RotParameterTypeData, ErrStat, ErrMsg, DE IF (ALLOCATED(RotParameterTypeData%TwrAxCent)) THEN DEALLOCATE(RotParameterTypeData%TwrAxCent) ENDIF - CALL BEMT_DestroyParam( RotParameterTypeData%BEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BEMT_DestroyParam( RotParameterTypeData%BEMT, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyParam( RotParameterTypeData%AA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AA_DestroyParam( RotParameterTypeData%AA, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(RotParameterTypeData%Jac_u_indx)) THEN DEALLOCATE(RotParameterTypeData%Jac_u_indx) @@ -13610,14 +13418,14 @@ SUBROUTINE AD_DestroyRotParameterType( RotParameterTypeData, ErrStat, ErrMsg, DE ENDIF IF (ALLOCATED(RotParameterTypeData%OutParam)) THEN DO i1 = LBOUND(RotParameterTypeData%OutParam,1), UBOUND(RotParameterTypeData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( RotParameterTypeData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyOutParmType( RotParameterTypeData%OutParam(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(RotParameterTypeData%OutParam) ENDIF IF (ALLOCATED(RotParameterTypeData%BldNd_OutParam)) THEN DO i1 = LBOUND(RotParameterTypeData%BldNd_OutParam,1), UBOUND(RotParameterTypeData%BldNd_OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( RotParameterTypeData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyOutParmType( RotParameterTypeData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(RotParameterTypeData%BldNd_OutParam) @@ -13625,7 +13433,7 @@ SUBROUTINE AD_DestroyRotParameterType( RotParameterTypeData, ErrStat, ErrMsg, DE IF (ALLOCATED(RotParameterTypeData%BldNd_BlOutNd)) THEN DEALLOCATE(RotParameterTypeData%BldNd_BlOutNd) ENDIF - CALL AD_Destroytfinparametertype( RotParameterTypeData%TFin, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyTFinParameterType( RotParameterTypeData%TFin, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyRotParameterType @@ -13825,7 +13633,7 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13854,7 +13662,7 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutParam upper/lower bounds for each dimension DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) Int_BufSz = Int_BufSz + 3 ! BldNd_OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13880,7 +13688,7 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut Int_BufSz = Int_BufSz + 1 ! TFinAero Int_BufSz = Int_BufSz + 3 ! TFin: size of buffers for each call to pack subtype - CALL AD_Packtfinparametertype( Re_Buf, Db_Buf, Int_Buf, InData%TFin, ErrStat2, ErrMsg2, .TRUE. ) ! TFin + CALL AD_PackTFinParameterType( Re_Buf, Db_Buf, Int_Buf, InData%TFin, ErrStat2, ErrMsg2, .TRUE. ) ! TFin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14366,7 +14174,7 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14423,7 +14231,7 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14472,7 +14280,7 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%TFinAero, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - CALL AD_Packtfinparametertype( Re_Buf, Db_Buf, Int_Buf, InData%TFin, ErrStat2, ErrMsg2, OnlySize ) ! TFin + CALL AD_PackTFinParameterType( Re_Buf, Db_Buf, Int_Buf, InData%TFin, ErrStat2, ErrMsg2, OnlySize ) ! TFin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15089,7 +14897,7 @@ SUBROUTINE AD_UnPackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15165,7 +14973,7 @@ SUBROUTINE AD_UnPackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_OutParam + CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15229,7 +15037,7 @@ SUBROUTINE AD_UnPackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Unpacktfinparametertype( Re_Buf, Db_Buf, Int_Buf, OutData%TFin, ErrStat2, ErrMsg2 ) ! TFin + CALL AD_UnpackTFinParameterType( Re_Buf, Db_Buf, Int_Buf, OutData%TFin, ErrStat2, ErrMsg2 ) ! TFin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15296,14 +15104,12 @@ SUBROUTINE AD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%UA_Flag = SrcParamData%UA_Flag END SUBROUTINE AD_CopyParam - SUBROUTINE AD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(AD_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyParam' @@ -15311,27 +15117,21 @@ SUBROUTINE AD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%rotors)) THEN DO i1 = LBOUND(ParamData%rotors,1), UBOUND(ParamData%rotors,1) - CALL AD_Destroyrotparametertype( ParamData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyRotParameterType( ParamData%rotors(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%rotors) ENDIF IF (ALLOCATED(ParamData%AFI)) THEN DO i1 = LBOUND(ParamData%AFI,1), UBOUND(ParamData%AFI,1) - CALL AFI_DestroyParam( ParamData%AFI(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AFI_DestroyParam( ParamData%AFI(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%AFI) ENDIF - CALL FVW_DestroyParam( ParamData%FVW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyParam( ParamData%FVW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyParam @@ -15376,7 +15176,7 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotparametertype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors + CALL AD_PackRotParameterType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15478,7 +15278,7 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotparametertype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors + CALL AD_PackRotParameterType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15667,7 +15467,7 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Unpackrotparametertype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors + CALL AD_UnpackRotParameterType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15898,14 +15698,12 @@ SUBROUTINE AD_CopyRotInputType( SrcRotInputTypeData, DstRotInputTypeData, CtrlCo ENDIF END SUBROUTINE AD_CopyRotInputType - SUBROUTINE AD_DestroyRotInputType( RotInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyRotInputType( RotInputTypeData, ErrStat, ErrMsg ) TYPE(RotInputType), INTENT(INOUT) :: RotInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotInputType' @@ -15913,12 +15711,6 @@ SUBROUTINE AD_DestroyRotInputType( RotInputTypeData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( RotInputTypeData%NacelleMotion, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL MeshDestroy( RotInputTypeData%TowerMotion, ErrStat2, ErrMsg2 ) @@ -16863,14 +16655,12 @@ SUBROUTINE AD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD_CopyInput - SUBROUTINE AD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(AD_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyInput' @@ -16878,15 +16668,9 @@ SUBROUTINE AD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputData%rotors)) THEN DO i1 = LBOUND(InputData%rotors,1), UBOUND(InputData%rotors,1) - CALL AD_Destroyrotinputtype( InputData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyRotInputType( InputData%rotors(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InputData%rotors) @@ -16937,7 +16721,7 @@ SUBROUTINE AD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotinputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors + CALL AD_PackRotInputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -16998,7 +16782,7 @@ SUBROUTINE AD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotinputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors + CALL AD_PackRotInputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17125,7 +16909,7 @@ SUBROUTINE AD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Unpackrotinputtype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors + CALL AD_UnpackRotInputType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17216,14 +17000,12 @@ SUBROUTINE AD_CopyRotOutputType( SrcRotOutputTypeData, DstRotOutputTypeData, Ctr ENDIF END SUBROUTINE AD_CopyRotOutputType - SUBROUTINE AD_DestroyRotOutputType( RotOutputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyRotOutputType( RotOutputTypeData, ErrStat, ErrMsg ) TYPE(RotOutputType), INTENT(INOUT) :: RotOutputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotOutputType' @@ -17231,12 +17013,6 @@ SUBROUTINE AD_DestroyRotOutputType( RotOutputTypeData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( RotOutputTypeData%NacelleLoad, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL MeshDestroy( RotOutputTypeData%HubLoad, ErrStat2, ErrMsg2 ) @@ -17882,14 +17658,12 @@ SUBROUTINE AD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs ENDIF END SUBROUTINE AD_CopyOutput - SUBROUTINE AD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(AD_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyOutput' @@ -17897,15 +17671,9 @@ SUBROUTINE AD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%rotors)) THEN DO i1 = LBOUND(OutputData%rotors,1), UBOUND(OutputData%rotors,1) - CALL AD_Destroyrotoutputtype( OutputData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyRotOutputType( OutputData%rotors(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OutputData%rotors) @@ -17953,7 +17721,7 @@ SUBROUTINE AD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_Packrotoutputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors + CALL AD_PackRotOutputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18009,7 +17777,7 @@ SUBROUTINE AD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_Packrotoutputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors + CALL AD_PackRotOutputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18115,7 +17883,7 @@ SUBROUTINE AD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_Unpackrotoutputtype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors + CALL AD_UnpackRotOutputType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index 64e6a7d477..8bcd73049b 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -68,7 +68,7 @@ MODULE AirfoilInfo_Types REAL(ReKi) :: k2 !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] REAL(ReKi) :: k3 !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] REAL(ReKi) :: k1_hat !< Constant in the expression of Cc due to leading edge vortex effects. [ignored if UAMod<>1] [-] - REAL(ReKi) :: x_cp_bar !< Constant in the expression of \hat(x)_cp^v [ignored if UAMod<>1, default = 0.2] [-] + REAL(ReKi) :: x_cp_bar !< Constant in the expression of hat(x)_cp^v [ignored if UAMod<>1, default = 0.2] [-] REAL(ReKi) :: UACutout !< Angle of attack above which unsteady aerodynamics are disabled [input in degrees; stored as radians] REAL(ReKi) :: UACutout_delta !< Number of angles-of-attack below UACutout where unsteady aerodynamics begin to be disabled [input in degrees; stored as radians] REAL(ReKi) :: UACutout_blend !< Angle of attack above which unsteady aerodynamics begins to be disabled [stored as radians] @@ -207,9 +207,6 @@ SUBROUTINE AFI_CopyUA_BL_Type( SrcUA_BL_TypeData, DstUA_BL_TypeData, CtrlCode, E CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_CopyUA_BL_Type' @@ -265,14 +262,12 @@ SUBROUTINE AFI_CopyUA_BL_Type( SrcUA_BL_TypeData, DstUA_BL_TypeData, CtrlCode, E DstUA_BL_TypeData%c_alphaUpperWrap = SrcUA_BL_TypeData%c_alphaUpperWrap END SUBROUTINE AFI_CopyUA_BL_Type - SUBROUTINE AFI_DestroyUA_BL_Type( UA_BL_TypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AFI_DestroyUA_BL_Type( UA_BL_TypeData, ErrStat, ErrMsg ) TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: UA_BL_TypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyUA_BL_Type' @@ -280,12 +275,6 @@ SUBROUTINE AFI_DestroyUA_BL_Type( UA_BL_TypeData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AFI_DestroyUA_BL_Type SUBROUTINE AFI_PackUA_BL_Type( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -506,9 +495,6 @@ SUBROUTINE AFI_UnPackUA_BL_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackUA_BL_Type' @@ -670,14 +656,12 @@ SUBROUTINE AFI_CopyUA_BL_Default_Type( SrcUA_BL_Default_TypeData, DstUA_BL_Defau DstUA_BL_Default_TypeData%alphaLower = SrcUA_BL_Default_TypeData%alphaLower END SUBROUTINE AFI_CopyUA_BL_Default_Type - SUBROUTINE AFI_DestroyUA_BL_Default_Type( UA_BL_Default_TypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AFI_DestroyUA_BL_Default_Type( UA_BL_Default_TypeData, ErrStat, ErrMsg ) TYPE(AFI_UA_BL_Default_Type), INTENT(INOUT) :: UA_BL_Default_TypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyUA_BL_Default_Type' @@ -685,12 +669,6 @@ SUBROUTINE AFI_DestroyUA_BL_Default_Type( UA_BL_Default_TypeData, ErrStat, ErrMs ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AFI_DestroyUA_BL_Default_Type SUBROUTINE AFI_PackUA_BL_Default_Type( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1034,14 +1012,12 @@ SUBROUTINE AFI_CopyTable_Type( SrcTable_TypeData, DstTable_TypeData, CtrlCode, E IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AFI_CopyTable_Type - SUBROUTINE AFI_DestroyTable_Type( Table_TypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AFI_DestroyTable_Type( Table_TypeData, ErrStat, ErrMsg ) TYPE(AFI_Table_Type), INTENT(INOUT) :: Table_TypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyTable_Type' @@ -1049,12 +1025,6 @@ SUBROUTINE AFI_DestroyTable_Type( Table_TypeData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(Table_TypeData%Alpha)) THEN DEALLOCATE(Table_TypeData%Alpha) ENDIF @@ -1064,7 +1034,7 @@ SUBROUTINE AFI_DestroyTable_Type( Table_TypeData, ErrStat, ErrMsg, DEALLOCATEpoi IF (ALLOCATED(Table_TypeData%SplineCoefs)) THEN DEALLOCATE(Table_TypeData%SplineCoefs) ENDIF - CALL AFI_Destroyua_bl_type( Table_TypeData%UA_BL, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AFI_DestroyUA_BL_Type( Table_TypeData%UA_BL, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AFI_DestroyTable_Type @@ -1125,7 +1095,7 @@ SUBROUTINE AFI_PackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_BufSz = Int_BufSz + 1 ! InclUAdata ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! UA_BL: size of buffers for each call to pack subtype - CALL AFI_Packua_bl_type( Re_Buf, Db_Buf, Int_Buf, InData%UA_BL, ErrStat2, ErrMsg2, .TRUE. ) ! UA_BL + CALL AFI_PackUA_BL_Type( Re_Buf, Db_Buf, Int_Buf, InData%UA_BL, ErrStat2, ErrMsg2, .TRUE. ) ! UA_BL CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1238,7 +1208,7 @@ SUBROUTINE AFI_PackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%InclUAdata, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - CALL AFI_Packua_bl_type( Re_Buf, Db_Buf, Int_Buf, InData%UA_BL, ErrStat2, ErrMsg2, OnlySize ) ! UA_BL + CALL AFI_PackUA_BL_Type( Re_Buf, Db_Buf, Int_Buf, InData%UA_BL, ErrStat2, ErrMsg2, OnlySize ) ! UA_BL CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1409,7 +1379,7 @@ SUBROUTINE AFI_UnPackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AFI_Unpackua_bl_type( Re_Buf, Db_Buf, Int_Buf, OutData%UA_BL, ErrStat2, ErrMsg2 ) ! UA_BL + CALL AFI_UnpackUA_BL_Type( Re_Buf, Db_Buf, Int_Buf, OutData%UA_BL, ErrStat2, ErrMsg2 ) ! UA_BL CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1442,14 +1412,12 @@ SUBROUTINE AFI_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%UA_f_cn = SrcInitInputData%UA_f_cn END SUBROUTINE AFI_CopyInitInput - SUBROUTINE AFI_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AFI_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(AFI_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyInitInput' @@ -1457,12 +1425,6 @@ SUBROUTINE AFI_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AFI_DestroyInitInput SUBROUTINE AFI_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1620,14 +1582,12 @@ SUBROUTINE AFI_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, E IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AFI_CopyInitOutput - SUBROUTINE AFI_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AFI_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(AFI_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyInitOutput' @@ -1635,13 +1595,7 @@ SUBROUTINE AFI_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AFI_DestroyInitOutput @@ -1682,7 +1636,7 @@ SUBROUTINE AFI_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1725,7 +1679,7 @@ SUBROUTINE AFI_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1814,7 +1768,7 @@ SUBROUTINE AFI_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1905,14 +1859,12 @@ SUBROUTINE AFI_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%FileName = SrcParamData%FileName END SUBROUTINE AFI_CopyParam - SUBROUTINE AFI_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AFI_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(AFI_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyParam' @@ -1920,12 +1872,6 @@ SUBROUTINE AFI_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%secondVals)) THEN DEALLOCATE(ParamData%secondVals) ENDIF @@ -1937,7 +1883,7 @@ SUBROUTINE AFI_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(ParamData%Table)) THEN DO i1 = LBOUND(ParamData%Table,1), UBOUND(ParamData%Table,1) - CALL AFI_Destroytable_type( ParamData%Table(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AFI_DestroyTable_Type( ParamData%Table(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%Table) @@ -2011,7 +1957,7 @@ SUBROUTINE AFI_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%Table,1), UBOUND(InData%Table,1) Int_BufSz = Int_BufSz + 3 ! Table: size of buffers for each call to pack subtype - CALL AFI_Packtable_type( Re_Buf, Db_Buf, Int_Buf, InData%Table(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Table + CALL AFI_PackTable_Type( Re_Buf, Db_Buf, Int_Buf, InData%Table(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Table CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2136,7 +2082,7 @@ SUBROUTINE AFI_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%Table,1), UBOUND(InData%Table,1) - CALL AFI_Packtable_type( Re_Buf, Db_Buf, Int_Buf, InData%Table(i1), ErrStat2, ErrMsg2, OnlySize ) ! Table + CALL AFI_PackTable_Type( Re_Buf, Db_Buf, Int_Buf, InData%Table(i1), ErrStat2, ErrMsg2, OnlySize ) ! Table CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2326,7 +2272,7 @@ SUBROUTINE AFI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AFI_Unpacktable_type( Re_Buf, Db_Buf, Int_Buf, OutData%Table(i1), ErrStat2, ErrMsg2 ) ! Table + CALL AFI_UnpackTable_Type( Re_Buf, Db_Buf, Int_Buf, OutData%Table(i1), ErrStat2, ErrMsg2 ) ! Table CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2364,14 +2310,12 @@ SUBROUTINE AFI_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg DstInputData%Re = SrcInputData%Re END SUBROUTINE AFI_CopyInput - SUBROUTINE AFI_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AFI_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(AFI_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyInput' @@ -2379,12 +2323,6 @@ SUBROUTINE AFI_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AFI_DestroyInput SUBROUTINE AFI_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2519,14 +2457,12 @@ SUBROUTINE AFI_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%FullyAttached = SrcOutputData%FullyAttached END SUBROUTINE AFI_CopyOutput - SUBROUTINE AFI_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AFI_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(AFI_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyOutput' @@ -2534,12 +2470,6 @@ SUBROUTINE AFI_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AFI_DestroyOutput SUBROUTINE AFI_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index afc972c2b4..f1b4b40e07 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -31,6 +31,7 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE BEMT_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE AirfoilInfo_Types USE UnsteadyAero_Types USE DBEMT_Types USE NWTC_Library @@ -116,7 +117,7 @@ MODULE BEMT_Types LOGICAL , DIMENSION(:,:), ALLOCATABLE :: ValidPhi !< set to indicate when there is no valid Phi for this node at this time (temporarially turn off induction when this is false) [-] LOGICAL :: nodesInitialized !< the node states have been initialized properly [-] TYPE(BEMT_ContinuousStateType) , DIMENSION(1:4) :: xdot !< history states for continuous state integration [-] - INTEGER(IntKi) :: n !< time step value used for continuous state integrator [-] + INTEGER(IntKi) :: n !< time step # value used for continuous state integrator [-] END TYPE BEMT_OtherStateType ! ======================= ! ========= BEMT_MiscVarType ======= @@ -232,7 +233,6 @@ SUBROUTINE BEMT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopyInitInput' @@ -382,14 +382,12 @@ SUBROUTINE BEMT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%BEM_Mod = SrcInitInputData%BEM_Mod END SUBROUTINE BEMT_CopyInitInput - SUBROUTINE BEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(BEMT_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyInitInput' @@ -397,12 +395,6 @@ SUBROUTINE BEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%chord)) THEN DEALLOCATE(InitInputData%chord) ENDIF @@ -788,7 +780,6 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: i INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackInitInput' @@ -1057,14 +1048,12 @@ SUBROUTINE BEMT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE BEMT_CopyInitOutput - SUBROUTINE BEMT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BEMT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(BEMT_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyInitOutput' @@ -1072,13 +1061,7 @@ SUBROUTINE BEMT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Version, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Version, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE BEMT_DestroyInitOutput @@ -1119,7 +1102,7 @@ SUBROUTINE BEMT_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Version: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Version, ErrStat2, ErrMsg2, .TRUE. ) ! Version + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Version, ErrStat2, ErrMsg2, .TRUE. ) ! Version CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1162,7 +1145,7 @@ SUBROUTINE BEMT_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Version, ErrStat2, ErrMsg2, OnlySize ) ! Version + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Version, ErrStat2, ErrMsg2, OnlySize ) ! Version CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1251,7 +1234,7 @@ SUBROUTINE BEMT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Version, ErrStat2, ErrMsg2 ) ! Version + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Version, ErrStat2, ErrMsg2 ) ! Version CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1280,14 +1263,12 @@ SUBROUTINE BEMT_CopySkewWake_InputType( SrcSkewWake_InputTypeData, DstSkewWake_I DstSkewWake_InputTypeData%R = SrcSkewWake_InputTypeData%R END SUBROUTINE BEMT_CopySkewWake_InputType - SUBROUTINE BEMT_DestroySkewWake_InputType( SkewWake_InputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BEMT_DestroySkewWake_InputType( SkewWake_InputTypeData, ErrStat, ErrMsg ) TYPE(BEMT_SkewWake_InputType), INTENT(INOUT) :: SkewWake_InputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroySkewWake_InputType' @@ -1295,12 +1276,6 @@ SUBROUTINE BEMT_DestroySkewWake_InputType( SkewWake_InputTypeData, ErrStat, ErrM ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE BEMT_DestroySkewWake_InputType SUBROUTINE BEMT_PackSkewWake_InputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1441,14 +1416,12 @@ SUBROUTINE BEMT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Err DstContStateData%V_w = SrcContStateData%V_w END SUBROUTINE BEMT_CopyContState - SUBROUTINE BEMT_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BEMT_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(BEMT_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyContState' @@ -1456,15 +1429,9 @@ SUBROUTINE BEMT_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL UA_DestroyContState( ContStateData%UA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL UA_DestroyContState( ContStateData%UA, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DBEMT_DestroyContState( ContStateData%DBEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DBEMT_DestroyContState( ContStateData%DBEMT, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE BEMT_DestroyContState @@ -1762,14 +1729,12 @@ SUBROUTINE BEMT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE BEMT_CopyDiscState - SUBROUTINE BEMT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BEMT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(BEMT_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyDiscState' @@ -1777,13 +1742,7 @@ SUBROUTINE BEMT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL UA_DestroyDiscState( DiscStateData%UA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL UA_DestroyDiscState( DiscStateData%UA, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE BEMT_DestroyDiscState @@ -1997,14 +1956,12 @@ SUBROUTINE BEMT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCod ENDIF END SUBROUTINE BEMT_CopyConstrState - SUBROUTINE BEMT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BEMT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(BEMT_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyConstrState' @@ -2012,12 +1969,6 @@ SUBROUTINE BEMT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ConstrStateData%phi)) THEN DEALLOCATE(ConstrStateData%phi) ENDIF @@ -2210,14 +2161,12 @@ SUBROUTINE BEMT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, DstOtherStateData%n = SrcOtherStateData%n END SUBROUTINE BEMT_CopyOtherState - SUBROUTINE BEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(BEMT_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyOtherState' @@ -2225,21 +2174,15 @@ SUBROUTINE BEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL UA_DestroyOtherState( OtherStateData%UA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL UA_DestroyOtherState( OtherStateData%UA, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DBEMT_DestroyOtherState( OtherStateData%DBEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DBEMT_DestroyOtherState( OtherStateData%DBEMT, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(OtherStateData%ValidPhi)) THEN DEALLOCATE(OtherStateData%ValidPhi) ENDIF DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL BEMT_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BEMT_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO END SUBROUTINE BEMT_DestroyOtherState @@ -2837,14 +2780,12 @@ SUBROUTINE BEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%BEM_weight = SrcMiscData%BEM_weight END SUBROUTINE BEMT_CopyMisc - SUBROUTINE BEMT_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BEMT_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(BEMT_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyMisc' @@ -2852,23 +2793,17 @@ SUBROUTINE BEMT_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL UA_DestroyMisc( MiscData%UA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL UA_DestroyMisc( MiscData%UA, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DBEMT_DestroyMisc( MiscData%DBEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DBEMT_DestroyMisc( MiscData%DBEMT, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL UA_DestroyOutput( MiscData%y_UA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL UA_DestroyOutput( MiscData%y_UA, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MiscData%u_UA)) THEN DO i3 = LBOUND(MiscData%u_UA,3), UBOUND(MiscData%u_UA,3) DO i2 = LBOUND(MiscData%u_UA,2), UBOUND(MiscData%u_UA,2) DO i1 = LBOUND(MiscData%u_UA,1), UBOUND(MiscData%u_UA,1) - CALL UA_DestroyInput( MiscData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL UA_DestroyInput( MiscData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -2876,11 +2811,11 @@ SUBROUTINE BEMT_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) DEALLOCATE(MiscData%u_UA) ENDIF DO i1 = LBOUND(MiscData%u_DBEMT,1), UBOUND(MiscData%u_DBEMT,1) - CALL DBEMT_DestroyInput( MiscData%u_DBEMT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DBEMT_DestroyInput( MiscData%u_DBEMT(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(MiscData%u_SkewWake,1), UBOUND(MiscData%u_SkewWake,1) - CALL BEMT_Destroyskewwake_inputtype( MiscData%u_SkewWake(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BEMT_DestroySkewWake_InputType( MiscData%u_SkewWake(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO IF (ALLOCATED(MiscData%TnInd_op)) THEN @@ -3047,7 +2982,7 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S END DO DO i1 = LBOUND(InData%u_SkewWake,1), UBOUND(InData%u_SkewWake,1) Int_BufSz = Int_BufSz + 3 ! u_SkewWake: size of buffers for each call to pack subtype - CALL BEMT_Packskewwake_inputtype( Re_Buf, Db_Buf, Int_Buf, InData%u_SkewWake(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_SkewWake + CALL BEMT_PackSkewWake_InputType( Re_Buf, Db_Buf, Int_Buf, InData%u_SkewWake(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_SkewWake CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3305,7 +3240,7 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ENDIF END DO DO i1 = LBOUND(InData%u_SkewWake,1), UBOUND(InData%u_SkewWake,1) - CALL BEMT_Packskewwake_inputtype( Re_Buf, Db_Buf, Int_Buf, InData%u_SkewWake(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_SkewWake + CALL BEMT_PackSkewWake_InputType( Re_Buf, Db_Buf, Int_Buf, InData%u_SkewWake(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_SkewWake CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3796,7 +3731,7 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BEMT_Unpackskewwake_inputtype( Re_Buf, Db_Buf, Int_Buf, OutData%u_SkewWake(i1), ErrStat2, ErrMsg2 ) ! u_SkewWake + CALL BEMT_UnpackSkewWake_InputType( Re_Buf, Db_Buf, Int_Buf, OutData%u_SkewWake(i1), ErrStat2, ErrMsg2 ) ! u_SkewWake CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4131,14 +4066,12 @@ SUBROUTINE BEMT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%BEM_Mod = SrcParamData%BEM_Mod END SUBROUTINE BEMT_CopyParam - SUBROUTINE BEMT_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BEMT_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(BEMT_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyParam' @@ -4146,12 +4079,6 @@ SUBROUTINE BEMT_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%chord)) THEN DEALLOCATE(ParamData%chord) ENDIF @@ -4167,9 +4094,9 @@ SUBROUTINE BEMT_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(ParamData%zHub)) THEN DEALLOCATE(ParamData%zHub) ENDIF - CALL UA_DestroyParam( ParamData%UA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL UA_DestroyParam( ParamData%UA, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DBEMT_DestroyParam( ParamData%DBEMT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DBEMT_DestroyParam( ParamData%DBEMT, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(ParamData%FixedInductions)) THEN DEALLOCATE(ParamData%FixedInductions) @@ -5071,14 +4998,12 @@ SUBROUTINE BEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE BEMT_CopyInput - SUBROUTINE BEMT_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BEMT_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(BEMT_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyInput' @@ -5086,12 +5011,6 @@ SUBROUTINE BEMT_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputData%theta)) THEN DEALLOCATE(InputData%theta) ENDIF @@ -6093,14 +6012,12 @@ SUBROUTINE BEMT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err ENDIF END SUBROUTINE BEMT_CopyOutput - SUBROUTINE BEMT_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BEMT_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(BEMT_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyOutput' @@ -6108,12 +6025,6 @@ SUBROUTINE BEMT_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%Vrel)) THEN DEALLOCATE(OutputData%Vrel) ENDIF diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index 423dd42b0b..f77964897a 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -77,7 +77,7 @@ MODULE DBEMT_Types LOGICAL , DIMENSION(:,:), ALLOCATABLE :: areStatesInitialized !< Flag indicating whether the module's states have been initialized properly [-] REAL(ReKi) :: tau1 !< value of tau1 used in updateStates (for output-to-file only) [-] REAL(ReKi) :: tau2 !< value of tau2 used in updateStates (equal to k_tau * tau1, not used between time steps) [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: n !< time step value used for continuous state integrator [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: n !< time step # value used for continuous state integrator [-] TYPE(DBEMT_ContinuousStateType) , DIMENSION(1:4) :: xdot !< derivative history for continuous state integrators [-] END TYPE DBEMT_OtherStateType ! ======================= @@ -128,7 +128,6 @@ SUBROUTINE DBEMT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_CopyInitInput' @@ -155,14 +154,12 @@ SUBROUTINE DBEMT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er ENDIF END SUBROUTINE DBEMT_CopyInitInput - SUBROUTINE DBEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DBEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(DBEMT_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyInitInput' @@ -170,12 +167,6 @@ SUBROUTINE DBEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%rLocal)) THEN DEALLOCATE(InitInputData%rLocal) ENDIF @@ -297,7 +288,6 @@ SUBROUTINE DBEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: i INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackInitInput' @@ -363,14 +353,12 @@ SUBROUTINE DBEMT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DBEMT_CopyInitOutput - SUBROUTINE DBEMT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DBEMT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(DBEMT_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyInitOutput' @@ -378,13 +366,7 @@ SUBROUTINE DBEMT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DBEMT_DestroyInitOutput @@ -425,7 +407,7 @@ SUBROUTINE DBEMT_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -468,7 +450,7 @@ SUBROUTINE DBEMT_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -557,7 +539,7 @@ SUBROUTINE DBEMT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -585,14 +567,12 @@ SUBROUTINE DBEMT_CopyElementContinuousStateType( SrcElementContinuousStateTypeDa DstElementContinuousStateTypeData%vind_1 = SrcElementContinuousStateTypeData%vind_1 END SUBROUTINE DBEMT_CopyElementContinuousStateType - SUBROUTINE DBEMT_DestroyElementContinuousStateType( ElementContinuousStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DBEMT_DestroyElementContinuousStateType( ElementContinuousStateTypeData, ErrStat, ErrMsg ) TYPE(DBEMT_ElementContinuousStateType), INTENT(INOUT) :: ElementContinuousStateTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyElementContinuousStateType' @@ -600,12 +580,6 @@ SUBROUTINE DBEMT_DestroyElementContinuousStateType( ElementContinuousStateTypeDa ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE DBEMT_DestroyElementContinuousStateType SUBROUTINE DBEMT_PackElementContinuousStateType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -761,14 +735,12 @@ SUBROUTINE DBEMT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Er ENDIF END SUBROUTINE DBEMT_CopyContState - SUBROUTINE DBEMT_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DBEMT_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(DBEMT_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyContState' @@ -776,16 +748,10 @@ SUBROUTINE DBEMT_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ContStateData%element)) THEN DO i2 = LBOUND(ContStateData%element,2), UBOUND(ContStateData%element,2) DO i1 = LBOUND(ContStateData%element,1), UBOUND(ContStateData%element,1) - CALL DBEMT_Destroyelementcontinuousstatetype( ContStateData%element(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DBEMT_DestroyElementContinuousStateType( ContStateData%element(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -835,7 +801,7 @@ SUBROUTINE DBEMT_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err DO i2 = LBOUND(InData%element,2), UBOUND(InData%element,2) DO i1 = LBOUND(InData%element,1), UBOUND(InData%element,1) Int_BufSz = Int_BufSz + 3 ! element: size of buffers for each call to pack subtype - CALL DBEMT_Packelementcontinuousstatetype( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! element + CALL DBEMT_PackElementContinuousStateType( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! element CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -896,7 +862,7 @@ SUBROUTINE DBEMT_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err DO i2 = LBOUND(InData%element,2), UBOUND(InData%element,2) DO i1 = LBOUND(InData%element,1), UBOUND(InData%element,1) - CALL DBEMT_Packelementcontinuousstatetype( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! element + CALL DBEMT_PackElementContinuousStateType( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! element CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1008,7 +974,7 @@ SUBROUTINE DBEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL DBEMT_Unpackelementcontinuousstatetype( Re_Buf, Db_Buf, Int_Buf, OutData%element(i1,i2), ErrStat2, ErrMsg2 ) ! element + CALL DBEMT_UnpackElementContinuousStateType( Re_Buf, Db_Buf, Int_Buf, OutData%element(i1,i2), ErrStat2, ErrMsg2 ) ! element CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1037,14 +1003,12 @@ SUBROUTINE DBEMT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Er DstDiscStateData%DummyState = SrcDiscStateData%DummyState END SUBROUTINE DBEMT_CopyDiscState - SUBROUTINE DBEMT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DBEMT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(DBEMT_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyDiscState' @@ -1052,12 +1016,6 @@ SUBROUTINE DBEMT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE DBEMT_DestroyDiscState SUBROUTINE DBEMT_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1174,14 +1132,12 @@ SUBROUTINE DBEMT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCo DstConstrStateData%DummyState = SrcConstrStateData%DummyState END SUBROUTINE DBEMT_CopyConstrState - SUBROUTINE DBEMT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DBEMT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(DBEMT_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyConstrState' @@ -1189,12 +1145,6 @@ SUBROUTINE DBEMT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCAT ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE DBEMT_DestroyConstrState SUBROUTINE DBEMT_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1347,14 +1297,12 @@ SUBROUTINE DBEMT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ENDDO END SUBROUTINE DBEMT_CopyOtherState - SUBROUTINE DBEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DBEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(DBEMT_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyOtherState' @@ -1362,12 +1310,6 @@ SUBROUTINE DBEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OtherStateData%areStatesInitialized)) THEN DEALLOCATE(OtherStateData%areStatesInitialized) ENDIF @@ -1375,7 +1317,7 @@ SUBROUTINE DBEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEp DEALLOCATE(OtherStateData%n) ENDIF DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL DBEMT_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DBEMT_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO END SUBROUTINE DBEMT_DestroyOtherState @@ -1691,14 +1633,12 @@ SUBROUTINE DBEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%FirstWarn_tau1 = SrcMiscData%FirstWarn_tau1 END SUBROUTINE DBEMT_CopyMisc - SUBROUTINE DBEMT_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DBEMT_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(DBEMT_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyMisc' @@ -1706,12 +1646,6 @@ SUBROUTINE DBEMT_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE DBEMT_DestroyMisc SUBROUTINE DBEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1850,14 +1784,12 @@ SUBROUTINE DBEMT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%DBEMT_Mod = SrcParamData%DBEMT_Mod END SUBROUTINE DBEMT_CopyParam - SUBROUTINE DBEMT_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DBEMT_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(DBEMT_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyParam' @@ -1865,12 +1797,6 @@ SUBROUTINE DBEMT_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%spanRatio)) THEN DEALLOCATE(ParamData%spanRatio) ENDIF @@ -2072,14 +1998,12 @@ SUBROUTINE DBEMT_CopyElementInputType( SrcElementInputTypeData, DstElementInputT DstElementInputTypeData%spanRatio = SrcElementInputTypeData%spanRatio END SUBROUTINE DBEMT_CopyElementInputType - SUBROUTINE DBEMT_DestroyElementInputType( ElementInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DBEMT_DestroyElementInputType( ElementInputTypeData, ErrStat, ErrMsg ) TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: ElementInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyElementInputType' @@ -2087,12 +2011,6 @@ SUBROUTINE DBEMT_DestroyElementInputType( ElementInputTypeData, ErrStat, ErrMsg, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE DBEMT_DestroyElementInputType SUBROUTINE DBEMT_PackElementInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2245,14 +2163,12 @@ SUBROUTINE DBEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs ENDIF END SUBROUTINE DBEMT_CopyInput - SUBROUTINE DBEMT_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DBEMT_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(DBEMT_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyInput' @@ -2260,16 +2176,10 @@ SUBROUTINE DBEMT_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputData%element)) THEN DO i2 = LBOUND(InputData%element,2), UBOUND(InputData%element,2) DO i1 = LBOUND(InputData%element,1), UBOUND(InputData%element,1) - CALL DBEMT_Destroyelementinputtype( InputData%element(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DBEMT_DestroyElementInputType( InputData%element(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -2322,7 +2232,7 @@ SUBROUTINE DBEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, DO i2 = LBOUND(InData%element,2), UBOUND(InData%element,2) DO i1 = LBOUND(InData%element,1), UBOUND(InData%element,1) Int_BufSz = Int_BufSz + 3 ! element: size of buffers for each call to pack subtype - CALL DBEMT_Packelementinputtype( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! element + CALL DBEMT_PackElementInputType( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! element CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2389,7 +2299,7 @@ SUBROUTINE DBEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, DO i2 = LBOUND(InData%element,2), UBOUND(InData%element,2) DO i1 = LBOUND(InData%element,1), UBOUND(InData%element,1) - CALL DBEMT_Packelementinputtype( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! element + CALL DBEMT_PackElementInputType( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! element CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2507,7 +2417,7 @@ SUBROUTINE DBEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL DBEMT_Unpackelementinputtype( Re_Buf, Db_Buf, Int_Buf, OutData%element(i1,i2), ErrStat2, ErrMsg2 ) ! element + CALL DBEMT_UnpackElementInputType( Re_Buf, Db_Buf, Int_Buf, OutData%element(i1,i2), ErrStat2, ErrMsg2 ) ! element CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2554,14 +2464,12 @@ SUBROUTINE DBEMT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er ENDIF END SUBROUTINE DBEMT_CopyOutput - SUBROUTINE DBEMT_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DBEMT_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(DBEMT_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyOutput' @@ -2569,12 +2477,6 @@ SUBROUTINE DBEMT_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%vind)) THEN DEALLOCATE(OutputData%vind) ENDIF diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index 40021d6932..eee3c3393c 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -31,6 +31,7 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE FVW_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE AirfoilInfo_Types USE UnsteadyAero_Types USE NWTC_Library IMPLICIT NONE @@ -425,14 +426,12 @@ SUBROUTINE FVW_CopyGridOutType( SrcGridOutTypeData, DstGridOutTypeData, CtrlCode DstGridOutTypeData%tLastOutput = SrcGridOutTypeData%tLastOutput END SUBROUTINE FVW_CopyGridOutType - SUBROUTINE FVW_DestroyGridOutType( GridOutTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyGridOutType( GridOutTypeData, ErrStat, ErrMsg ) TYPE(GridOutType), INTENT(INOUT) :: GridOutTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyGridOutType' @@ -440,12 +439,6 @@ SUBROUTINE FVW_DestroyGridOutType( GridOutTypeData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(GridOutTypeData%uGrid)) THEN DEALLOCATE(GridOutTypeData%uGrid) ENDIF @@ -838,14 +831,12 @@ SUBROUTINE FVW_CopyT_Sgmt( SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrM DstT_SgmtData%nActP = SrcT_SgmtData%nActP END SUBROUTINE FVW_CopyT_Sgmt - SUBROUTINE FVW_DestroyT_Sgmt( T_SgmtData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyT_Sgmt( T_SgmtData, ErrStat, ErrMsg ) TYPE(T_Sgmt), INTENT(INOUT) :: T_SgmtData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyT_Sgmt' @@ -853,12 +844,6 @@ SUBROUTINE FVW_DestroyT_Sgmt( T_SgmtData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(T_SgmtData%Points)) THEN DEALLOCATE(T_SgmtData%Points) ENDIF @@ -1214,14 +1199,12 @@ SUBROUTINE FVW_CopyT_Part( SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrM DstT_PartData%nAct = SrcT_PartData%nAct END SUBROUTINE FVW_CopyT_Part - SUBROUTINE FVW_DestroyT_Part( T_PartData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyT_Part( T_PartData, ErrStat, ErrMsg ) TYPE(T_Part), INTENT(INOUT) :: T_PartData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyT_Part' @@ -1229,12 +1212,6 @@ SUBROUTINE FVW_DestroyT_Part( T_PartData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(T_PartData%P)) THEN DEALLOCATE(T_PartData%P) ENDIF @@ -1578,14 +1555,12 @@ SUBROUTINE FVW_CopyWng_ParameterType( SrcWng_ParameterTypeData, DstWng_Parameter ENDIF END SUBROUTINE FVW_CopyWng_ParameterType - SUBROUTINE FVW_DestroyWng_ParameterType( Wng_ParameterTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyWng_ParameterType( Wng_ParameterTypeData, ErrStat, ErrMsg ) TYPE(Wng_ParameterType), INTENT(INOUT) :: Wng_ParameterTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_ParameterType' @@ -1593,12 +1568,6 @@ SUBROUTINE FVW_DestroyWng_ParameterType( Wng_ParameterTypeData, ErrStat, ErrMsg, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(Wng_ParameterTypeData%chord_LL)) THEN DEALLOCATE(Wng_ParameterTypeData%chord_LL) ENDIF @@ -2056,14 +2025,12 @@ SUBROUTINE FVW_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%kFrozenNWEnd = SrcParamData%kFrozenNWEnd END SUBROUTINE FVW_CopyParam - SUBROUTINE FVW_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(FVW_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyParam' @@ -2071,15 +2038,9 @@ SUBROUTINE FVW_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%W)) THEN DO i1 = LBOUND(ParamData%W,1), UBOUND(ParamData%W,1) - CALL FVW_Destroywng_parametertype( ParamData%W(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyWng_ParameterType( ParamData%W(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%W) @@ -2132,7 +2093,7 @@ SUBROUTINE FVW_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_Packwng_parametertype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W + CALL FVW_PackWng_ParameterType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2242,7 +2203,7 @@ SUBROUTINE FVW_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - CALL FVW_Packwng_parametertype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W + CALL FVW_PackWng_ParameterType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2475,7 +2436,7 @@ SUBROUTINE FVW_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FVW_Unpackwng_parametertype( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W + CALL FVW_UnpackWng_ParameterType( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2728,14 +2689,12 @@ SUBROUTINE FVW_CopyWng_ContinuousStateType( SrcWng_ContinuousStateTypeData, DstW ENDIF END SUBROUTINE FVW_CopyWng_ContinuousStateType - SUBROUTINE FVW_DestroyWng_ContinuousStateType( Wng_ContinuousStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyWng_ContinuousStateType( Wng_ContinuousStateTypeData, ErrStat, ErrMsg ) TYPE(Wng_ContinuousStateType), INTENT(INOUT) :: Wng_ContinuousStateTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_ContinuousStateType' @@ -2743,12 +2702,6 @@ SUBROUTINE FVW_DestroyWng_ContinuousStateType( Wng_ContinuousStateTypeData, ErrS ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(Wng_ContinuousStateTypeData%Gamma_NW)) THEN DEALLOCATE(Wng_ContinuousStateTypeData%Gamma_NW) ENDIF @@ -3241,14 +3194,12 @@ SUBROUTINE FVW_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrS ENDIF END SUBROUTINE FVW_CopyContState - SUBROUTINE FVW_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(FVW_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyContState' @@ -3256,22 +3207,16 @@ SUBROUTINE FVW_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ContStateData%W)) THEN DO i1 = LBOUND(ContStateData%W,1), UBOUND(ContStateData%W,1) - CALL FVW_Destroywng_continuousstatetype( ContStateData%W(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyWng_ContinuousStateType( ContStateData%W(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ContStateData%W) ENDIF IF (ALLOCATED(ContStateData%UA)) THEN DO i1 = LBOUND(ContStateData%UA,1), UBOUND(ContStateData%UA,1) - CALL UA_DestroyContState( ContStateData%UA(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL UA_DestroyContState( ContStateData%UA(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ContStateData%UA) @@ -3319,7 +3264,7 @@ SUBROUTINE FVW_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_Packwng_continuousstatetype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W + CALL FVW_PackWng_ContinuousStateType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3398,7 +3343,7 @@ SUBROUTINE FVW_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - CALL FVW_Packwng_continuousstatetype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W + CALL FVW_PackWng_ContinuousStateType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3545,7 +3490,7 @@ SUBROUTINE FVW_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FVW_Unpackwng_continuousstatetype( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W + CALL FVW_UnpackWng_ContinuousStateType( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3644,14 +3589,12 @@ SUBROUTINE FVW_CopyWng_OutputType( SrcWng_OutputTypeData, DstWng_OutputTypeData, ENDIF END SUBROUTINE FVW_CopyWng_OutputType - SUBROUTINE FVW_DestroyWng_OutputType( Wng_OutputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyWng_OutputType( Wng_OutputTypeData, ErrStat, ErrMsg ) TYPE(Wng_OutputType), INTENT(INOUT) :: Wng_OutputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_OutputType' @@ -3659,12 +3602,6 @@ SUBROUTINE FVW_DestroyWng_OutputType( Wng_OutputTypeData, ErrStat, ErrMsg, DEALL ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(Wng_OutputTypeData%Vind)) THEN DEALLOCATE(Wng_OutputTypeData%Vind) ENDIF @@ -3845,14 +3782,12 @@ SUBROUTINE FVW_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM ENDIF END SUBROUTINE FVW_CopyOutput - SUBROUTINE FVW_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(FVW_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyOutput' @@ -3860,15 +3795,9 @@ SUBROUTINE FVW_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%W)) THEN DO i1 = LBOUND(OutputData%W,1), UBOUND(OutputData%W,1) - CALL FVW_Destroywng_outputtype( OutputData%W(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyWng_OutputType( OutputData%W(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OutputData%W) @@ -3916,7 +3845,7 @@ SUBROUTINE FVW_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_Packwng_outputtype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W + CALL FVW_PackWng_OutputType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3972,7 +3901,7 @@ SUBROUTINE FVW_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - CALL FVW_Packwng_outputtype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W + CALL FVW_PackWng_OutputType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4078,7 +4007,7 @@ SUBROUTINE FVW_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FVW_Unpackwng_outputtype( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W + CALL FVW_UnpackWng_OutputType( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4641,14 +4570,12 @@ SUBROUTINE FVW_CopyWng_MiscVarType( SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDa ENDIF END SUBROUTINE FVW_CopyWng_MiscVarType - SUBROUTINE FVW_DestroyWng_MiscVarType( Wng_MiscVarTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyWng_MiscVarType( Wng_MiscVarTypeData, ErrStat, ErrMsg ) TYPE(Wng_MiscVarType), INTENT(INOUT) :: Wng_MiscVarTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_MiscVarType' @@ -4656,12 +4583,6 @@ SUBROUTINE FVW_DestroyWng_MiscVarType( Wng_MiscVarTypeData, ErrStat, ErrMsg, DEA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(Wng_MiscVarTypeData%LE)) THEN DEALLOCATE(Wng_MiscVarTypeData%LE) ENDIF @@ -4728,17 +4649,17 @@ SUBROUTINE FVW_DestroyWng_MiscVarType( Wng_MiscVarTypeData, ErrStat, ErrMsg, DEA IF (ALLOCATED(Wng_MiscVarTypeData%u_UA)) THEN DO i2 = LBOUND(Wng_MiscVarTypeData%u_UA,2), UBOUND(Wng_MiscVarTypeData%u_UA,2) DO i1 = LBOUND(Wng_MiscVarTypeData%u_UA,1), UBOUND(Wng_MiscVarTypeData%u_UA,1) - CALL UA_DestroyInput( Wng_MiscVarTypeData%u_UA(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL UA_DestroyInput( Wng_MiscVarTypeData%u_UA(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO DEALLOCATE(Wng_MiscVarTypeData%u_UA) ENDIF - CALL UA_DestroyMisc( Wng_MiscVarTypeData%m_UA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL UA_DestroyMisc( Wng_MiscVarTypeData%m_UA, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL UA_DestroyOutput( Wng_MiscVarTypeData%y_UA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL UA_DestroyOutput( Wng_MiscVarTypeData%y_UA, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL UA_DestroyParam( Wng_MiscVarTypeData%p_UA, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL UA_DestroyParam( Wng_MiscVarTypeData%p_UA, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(Wng_MiscVarTypeData%Vind_LL)) THEN DEALLOCATE(Wng_MiscVarTypeData%Vind_LL) @@ -7078,14 +6999,12 @@ SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FVW_CopyMisc - SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(FVW_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyMisc' @@ -7093,15 +7012,9 @@ SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MiscData%W)) THEN DO i1 = LBOUND(MiscData%W,1), UBOUND(MiscData%W,1) - CALL FVW_Destroywng_miscvartype( MiscData%W(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyWng_MiscVarType( MiscData%W(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%W) @@ -7109,15 +7022,15 @@ SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(MiscData%r_wind)) THEN DEALLOCATE(MiscData%r_wind) ENDIF - CALL FVW_DestroyContState( MiscData%dxdt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyContState( MiscData%dxdt, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_DestroyContState( MiscData%x1, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyContState( MiscData%x1, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_DestroyContState( MiscData%x2, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyContState( MiscData%x2, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_Destroyt_sgmt( MiscData%Sgmt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyT_Sgmt( MiscData%Sgmt, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_Destroyt_part( MiscData%Part, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyT_Part( MiscData%Part, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MiscData%CPs)) THEN DEALLOCATE(MiscData%CPs) @@ -7127,7 +7040,7 @@ SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(MiscData%GridOutputs)) THEN DO i1 = LBOUND(MiscData%GridOutputs,1), UBOUND(MiscData%GridOutputs,1) - CALL FVW_Destroygridouttype( MiscData%GridOutputs(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyGridOutType( MiscData%GridOutputs(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%GridOutputs) @@ -7175,7 +7088,7 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_Packwng_miscvartype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W + CALL FVW_PackWng_MiscVarType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7261,7 +7174,7 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_BufSz = Db_BufSz + 1 ! t2 Int_BufSz = Int_BufSz + 1 ! UA_Flag Int_BufSz = Int_BufSz + 3 ! Sgmt: size of buffers for each call to pack subtype - CALL FVW_Packt_sgmt( Re_Buf, Db_Buf, Int_Buf, InData%Sgmt, ErrStat2, ErrMsg2, .TRUE. ) ! Sgmt + CALL FVW_PackT_Sgmt( Re_Buf, Db_Buf, Int_Buf, InData%Sgmt, ErrStat2, ErrMsg2, .TRUE. ) ! Sgmt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7278,7 +7191,7 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Part: size of buffers for each call to pack subtype - CALL FVW_Packt_part( Re_Buf, Db_Buf, Int_Buf, InData%Part, ErrStat2, ErrMsg2, .TRUE. ) ! Part + CALL FVW_PackT_Part( Re_Buf, Db_Buf, Int_Buf, InData%Part, ErrStat2, ErrMsg2, .TRUE. ) ! Part CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7309,7 +7222,7 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*1 ! GridOutputs upper/lower bounds for each dimension DO i1 = LBOUND(InData%GridOutputs,1), UBOUND(InData%GridOutputs,1) Int_BufSz = Int_BufSz + 3 ! GridOutputs: size of buffers for each call to pack subtype - CALL FVW_Packgridouttype( Re_Buf, Db_Buf, Int_Buf, InData%GridOutputs(i1), ErrStat2, ErrMsg2, .TRUE. ) ! GridOutputs + CALL FVW_PackGridOutType( Re_Buf, Db_Buf, Int_Buf, InData%GridOutputs(i1), ErrStat2, ErrMsg2, .TRUE. ) ! GridOutputs CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7365,7 +7278,7 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - CALL FVW_Packwng_miscvartype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W + CALL FVW_PackWng_MiscVarType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7521,7 +7434,7 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = Db_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - CALL FVW_Packt_sgmt( Re_Buf, Db_Buf, Int_Buf, InData%Sgmt, ErrStat2, ErrMsg2, OnlySize ) ! Sgmt + CALL FVW_PackT_Sgmt( Re_Buf, Db_Buf, Int_Buf, InData%Sgmt, ErrStat2, ErrMsg2, OnlySize ) ! Sgmt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7549,7 +7462,7 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FVW_Packt_part( Re_Buf, Db_Buf, Int_Buf, InData%Part, ErrStat2, ErrMsg2, OnlySize ) ! Part + CALL FVW_PackT_Part( Re_Buf, Db_Buf, Int_Buf, InData%Part, ErrStat2, ErrMsg2, OnlySize ) ! Part CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7628,7 +7541,7 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%GridOutputs,1), UBOUND(InData%GridOutputs,1) - CALL FVW_Packgridouttype( Re_Buf, Db_Buf, Int_Buf, InData%GridOutputs(i1), ErrStat2, ErrMsg2, OnlySize ) ! GridOutputs + CALL FVW_PackGridOutType( Re_Buf, Db_Buf, Int_Buf, InData%GridOutputs(i1), ErrStat2, ErrMsg2, OnlySize ) ! GridOutputs CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7735,7 +7648,7 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FVW_Unpackwng_miscvartype( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W + CALL FVW_UnpackWng_MiscVarType( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7942,7 +7855,7 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FVW_Unpackt_sgmt( Re_Buf, Db_Buf, Int_Buf, OutData%Sgmt, ErrStat2, ErrMsg2 ) ! Sgmt + CALL FVW_UnpackT_Sgmt( Re_Buf, Db_Buf, Int_Buf, OutData%Sgmt, ErrStat2, ErrMsg2 ) ! Sgmt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7982,7 +7895,7 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FVW_Unpackt_part( Re_Buf, Db_Buf, Int_Buf, OutData%Part, ErrStat2, ErrMsg2 ) ! Part + CALL FVW_UnpackT_Part( Re_Buf, Db_Buf, Int_Buf, OutData%Part, ErrStat2, ErrMsg2 ) ! Part CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8082,7 +7995,7 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FVW_Unpackgridouttype( Re_Buf, Db_Buf, Int_Buf, OutData%GridOutputs(i1), ErrStat2, ErrMsg2 ) ! GridOutputs + CALL FVW_UnpackGridOutType( Re_Buf, Db_Buf, Int_Buf, OutData%GridOutputs(i1), ErrStat2, ErrMsg2 ) ! GridOutputs CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8113,14 +8026,12 @@ SUBROUTINE FVW_CopyRot_InputType( SrcRot_InputTypeData, DstRot_InputTypeData, Ct DstRot_InputTypeData%HubPosition = SrcRot_InputTypeData%HubPosition END SUBROUTINE FVW_CopyRot_InputType - SUBROUTINE FVW_DestroyRot_InputType( Rot_InputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyRot_InputType( Rot_InputTypeData, ErrStat, ErrMsg ) TYPE(Rot_InputType), INTENT(INOUT) :: Rot_InputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyRot_InputType' @@ -8128,12 +8039,6 @@ SUBROUTINE FVW_DestroyRot_InputType( Rot_InputTypeData, ErrStat, ErrMsg, DEALLOC ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE FVW_DestroyRot_InputType SUBROUTINE FVW_PackRot_InputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -8302,14 +8207,12 @@ SUBROUTINE FVW_CopyWng_InputType( SrcWng_InputTypeData, DstWng_InputTypeData, Ct ENDIF END SUBROUTINE FVW_CopyWng_InputType - SUBROUTINE FVW_DestroyWng_InputType( Wng_InputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyWng_InputType( Wng_InputTypeData, ErrStat, ErrMsg ) TYPE(Wng_InputType), INTENT(INOUT) :: Wng_InputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_InputType' @@ -8317,12 +8220,6 @@ SUBROUTINE FVW_DestroyWng_InputType( Wng_InputTypeData, ErrStat, ErrMsg, DEALLOC ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(Wng_InputTypeData%Vwnd_LL)) THEN DEALLOCATE(Wng_InputTypeData%Vwnd_LL) ENDIF @@ -8591,14 +8488,12 @@ SUBROUTINE FVW_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE FVW_CopyInput - SUBROUTINE FVW_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(FVW_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInput' @@ -8606,22 +8501,16 @@ SUBROUTINE FVW_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputData%rotors)) THEN DO i1 = LBOUND(InputData%rotors,1), UBOUND(InputData%rotors,1) - CALL FVW_Destroyrot_inputtype( InputData%rotors(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyRot_InputType( InputData%rotors(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InputData%rotors) ENDIF IF (ALLOCATED(InputData%W)) THEN DO i1 = LBOUND(InputData%W,1), UBOUND(InputData%W,1) - CALL FVW_Destroywng_inputtype( InputData%W(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyWng_InputType( InputData%W(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InputData%W) @@ -8679,7 +8568,7 @@ SUBROUTINE FVW_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL FVW_Packrot_inputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors + CALL FVW_PackRot_InputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8702,7 +8591,7 @@ SUBROUTINE FVW_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_Packwng_inputtype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W + CALL FVW_PackWng_InputType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8786,7 +8675,7 @@ SUBROUTINE FVW_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL FVW_Packrot_inputtype( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors + CALL FVW_PackRot_InputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8827,7 +8716,7 @@ SUBROUTINE FVW_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - CALL FVW_Packwng_inputtype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W + CALL FVW_PackWng_InputType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8995,7 +8884,7 @@ SUBROUTINE FVW_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FVW_Unpackrot_inputtype( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors + CALL FVW_UnpackRot_InputType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9051,7 +8940,7 @@ SUBROUTINE FVW_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FVW_Unpackwng_inputtype( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W + CALL FVW_UnpackWng_InputType( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9175,14 +9064,12 @@ SUBROUTINE FVW_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS ENDIF END SUBROUTINE FVW_CopyDiscState - SUBROUTINE FVW_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(FVW_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyDiscState' @@ -9190,15 +9077,9 @@ SUBROUTINE FVW_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(DiscStateData%UA)) THEN DO i1 = LBOUND(DiscStateData%UA,1), UBOUND(DiscStateData%UA,1) - CALL UA_DestroyDiscState( DiscStateData%UA(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL UA_DestroyDiscState( DiscStateData%UA(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(DiscStateData%UA) @@ -9453,14 +9334,12 @@ SUBROUTINE FVW_CopyWng_ConstraintStateType( SrcWng_ConstraintStateTypeData, DstW ENDIF END SUBROUTINE FVW_CopyWng_ConstraintStateType - SUBROUTINE FVW_DestroyWng_ConstraintStateType( Wng_ConstraintStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyWng_ConstraintStateType( Wng_ConstraintStateTypeData, ErrStat, ErrMsg ) TYPE(Wng_ConstraintStateType), INTENT(INOUT) :: Wng_ConstraintStateTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_ConstraintStateType' @@ -9468,12 +9347,6 @@ SUBROUTINE FVW_DestroyWng_ConstraintStateType( Wng_ConstraintStateTypeData, ErrS ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(Wng_ConstraintStateTypeData%Gamma_LL)) THEN DEALLOCATE(Wng_ConstraintStateTypeData%Gamma_LL) ENDIF @@ -9644,14 +9517,12 @@ SUBROUTINE FVW_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode DstConstrStateData%residual = SrcConstrStateData%residual END SUBROUTINE FVW_CopyConstrState - SUBROUTINE FVW_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(FVW_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyConstrState' @@ -9659,15 +9530,9 @@ SUBROUTINE FVW_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ConstrStateData%W)) THEN DO i1 = LBOUND(ConstrStateData%W,1), UBOUND(ConstrStateData%W,1) - CALL FVW_Destroywng_constraintstatetype( ConstrStateData%W(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyWng_ConstraintStateType( ConstrStateData%W(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ConstrStateData%W) @@ -9715,7 +9580,7 @@ SUBROUTINE FVW_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_Packwng_constraintstatetype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W + CALL FVW_PackWng_ConstraintStateType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9772,7 +9637,7 @@ SUBROUTINE FVW_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - CALL FVW_Packwng_constraintstatetype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W + CALL FVW_PackWng_ConstraintStateType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9880,7 +9745,7 @@ SUBROUTINE FVW_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FVW_Unpackwng_constraintstatetype( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W + CALL FVW_UnpackWng_ConstraintStateType( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9927,14 +9792,12 @@ SUBROUTINE FVW_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E ENDIF END SUBROUTINE FVW_CopyOtherState - SUBROUTINE FVW_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(FVW_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyOtherState' @@ -9942,15 +9805,9 @@ SUBROUTINE FVW_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OtherStateData%UA)) THEN DO i1 = LBOUND(OtherStateData%UA,1), UBOUND(OtherStateData%UA,1) - CALL UA_DestroyOtherState( OtherStateData%UA(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL UA_DestroyOtherState( OtherStateData%UA(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OtherStateData%UA) @@ -10235,14 +10092,12 @@ SUBROUTINE FVW_CopyWng_InitInputType( SrcWng_InitInputTypeData, DstWng_InitInput DstWng_InitInputTypeData%UAOff_outerNode = SrcWng_InitInputTypeData%UAOff_outerNode END SUBROUTINE FVW_CopyWng_InitInputType - SUBROUTINE FVW_DestroyWng_InitInputType( Wng_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyWng_InitInputType( Wng_InitInputTypeData, ErrStat, ErrMsg ) TYPE(Wng_InitInputType), INTENT(INOUT) :: Wng_InitInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_InitInputType' @@ -10250,12 +10105,6 @@ SUBROUTINE FVW_DestroyWng_InitInputType( Wng_InitInputTypeData, ErrStat, ErrMsg, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(Wng_InitInputTypeData%AFindx)) THEN DEALLOCATE(Wng_InitInputTypeData%AFindx) ENDIF @@ -10561,14 +10410,12 @@ SUBROUTINE FVW_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%SumPrint = SrcInitInputData%SumPrint END SUBROUTINE FVW_CopyInitInput - SUBROUTINE FVW_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(FVW_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInitInput' @@ -10576,15 +10423,9 @@ SUBROUTINE FVW_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%W)) THEN DO i1 = LBOUND(InitInputData%W,1), UBOUND(InitInputData%W,1) - CALL FVW_Destroywng_initinputtype( InitInputData%W(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FVW_DestroyWng_InitInputType( InitInputData%W(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InitInputData%W) @@ -10641,7 +10482,7 @@ SUBROUTINE FVW_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_Packwng_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W + CALL FVW_PackWng_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10738,7 +10579,7 @@ SUBROUTINE FVW_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - CALL FVW_Packwng_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W + CALL FVW_PackWng_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10913,7 +10754,7 @@ SUBROUTINE FVW_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FVW_Unpackwng_initinputtype( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W + CALL FVW_UnpackWng_InitInputType( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11049,14 +10890,12 @@ SUBROUTINE FVW_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%VTKCoord = SrcInputFileData%VTKCoord END SUBROUTINE FVW_CopyInputFile - SUBROUTINE FVW_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) TYPE(FVW_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInputFile' @@ -11064,12 +10903,6 @@ SUBROUTINE FVW_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE FVW_DestroyInputFile SUBROUTINE FVW_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -11364,14 +11197,12 @@ SUBROUTINE FVW_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%Dummy = SrcInitOutputData%Dummy END SUBROUTINE FVW_CopyInitOutput - SUBROUTINE FVW_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FVW_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(FVW_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInitOutput' @@ -11379,12 +11210,6 @@ SUBROUTINE FVW_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE FVW_DestroyInitOutput SUBROUTINE FVW_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 3a42342068..4702a51955 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -309,14 +309,12 @@ SUBROUTINE UA_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt ENDIF END SUBROUTINE UA_CopyInitInput - SUBROUTINE UA_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE UA_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(UA_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyInitInput' @@ -324,12 +322,6 @@ SUBROUTINE UA_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%c)) THEN DEALLOCATE(InitInputData%c) ENDIF @@ -652,14 +644,12 @@ SUBROUTINE UA_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er ENDIF END SUBROUTINE UA_CopyInitOutput - SUBROUTINE UA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE UA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(UA_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyInitOutput' @@ -667,13 +657,7 @@ SUBROUTINE UA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Version, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Version, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) @@ -720,7 +704,7 @@ SUBROUTINE UA_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Version: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Version, ErrStat2, ErrMsg2, .TRUE. ) ! Version + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Version, ErrStat2, ErrMsg2, .TRUE. ) ! Version CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -773,7 +757,7 @@ SUBROUTINE UA_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Version, ErrStat2, ErrMsg2, OnlySize ) ! Version + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Version, ErrStat2, ErrMsg2, OnlySize ) ! Version CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -897,7 +881,7 @@ SUBROUTINE UA_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Version, ErrStat2, ErrMsg2 ) ! Version + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Version, ErrStat2, ErrMsg2 ) ! Version CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1013,14 +997,12 @@ SUBROUTINE UA_CopyKelvinChainType( SrcKelvinChainTypeData, DstKelvinChainTypeDat DstKelvinChainTypeData%ds = SrcKelvinChainTypeData%ds END SUBROUTINE UA_CopyKelvinChainType - SUBROUTINE UA_DestroyKelvinChainType( KelvinChainTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE UA_DestroyKelvinChainType( KelvinChainTypeData, ErrStat, ErrMsg ) TYPE(UA_KelvinChainType), INTENT(INOUT) :: KelvinChainTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyKelvinChainType' @@ -1028,12 +1010,6 @@ SUBROUTINE UA_DestroyKelvinChainType( KelvinChainTypeData, ErrStat, ErrMsg, DEAL ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE UA_DestroyKelvinChainType SUBROUTINE UA_PackKelvinChainType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1401,14 +1377,12 @@ SUBROUTINE UA_CopyElementContinuousStateType( SrcElementContinuousStateTypeData, DstElementContinuousStateTypeData%x = SrcElementContinuousStateTypeData%x END SUBROUTINE UA_CopyElementContinuousStateType - SUBROUTINE UA_DestroyElementContinuousStateType( ElementContinuousStateTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE UA_DestroyElementContinuousStateType( ElementContinuousStateTypeData, ErrStat, ErrMsg ) TYPE(UA_ElementContinuousStateType), INTENT(INOUT) :: ElementContinuousStateTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyElementContinuousStateType' @@ -1416,12 +1390,6 @@ SUBROUTINE UA_DestroyElementContinuousStateType( ElementContinuousStateTypeData, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE UA_DestroyElementContinuousStateType SUBROUTINE UA_PackElementContinuousStateType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1566,14 +1534,12 @@ SUBROUTINE UA_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrSt ENDIF END SUBROUTINE UA_CopyContState - SUBROUTINE UA_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE UA_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(UA_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyContState' @@ -1581,16 +1547,10 @@ SUBROUTINE UA_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ContStateData%element)) THEN DO i2 = LBOUND(ContStateData%element,2), UBOUND(ContStateData%element,2) DO i1 = LBOUND(ContStateData%element,1), UBOUND(ContStateData%element,1) - CALL UA_Destroyelementcontinuousstatetype( ContStateData%element(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL UA_DestroyElementContinuousStateType( ContStateData%element(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -1640,7 +1600,7 @@ SUBROUTINE UA_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg DO i2 = LBOUND(InData%element,2), UBOUND(InData%element,2) DO i1 = LBOUND(InData%element,1), UBOUND(InData%element,1) Int_BufSz = Int_BufSz + 3 ! element: size of buffers for each call to pack subtype - CALL UA_Packelementcontinuousstatetype( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! element + CALL UA_PackElementContinuousStateType( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! element CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1701,7 +1661,7 @@ SUBROUTINE UA_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg DO i2 = LBOUND(InData%element,2), UBOUND(InData%element,2) DO i1 = LBOUND(InData%element,1), UBOUND(InData%element,1) - CALL UA_Packelementcontinuousstatetype( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! element + CALL UA_PackElementContinuousStateType( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! element CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1813,7 +1773,7 @@ SUBROUTINE UA_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL UA_Unpackelementcontinuousstatetype( Re_Buf, Db_Buf, Int_Buf, OutData%element(i1,i2), ErrStat2, ErrMsg2 ) ! element + CALL UA_UnpackElementContinuousStateType( Re_Buf, Db_Buf, Int_Buf, OutData%element(i1,i2), ErrStat2, ErrMsg2 ) ! element CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2319,14 +2279,12 @@ SUBROUTINE UA_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt ENDIF END SUBROUTINE UA_CopyDiscState - SUBROUTINE UA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE UA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(UA_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyDiscState' @@ -2334,12 +2292,6 @@ SUBROUTINE UA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(DiscStateData%alpha_minus1)) THEN DEALLOCATE(DiscStateData%alpha_minus1) ENDIF @@ -4187,14 +4139,12 @@ SUBROUTINE UA_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%DummyConstraintState = SrcConstrStateData%DummyConstraintState END SUBROUTINE UA_CopyConstrState - SUBROUTINE UA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE UA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(UA_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyConstrState' @@ -4202,12 +4152,6 @@ SUBROUTINE UA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE UA_DestroyConstrState SUBROUTINE UA_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -4512,14 +4456,12 @@ SUBROUTINE UA_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, Er ENDIF END SUBROUTINE UA_CopyOtherState - SUBROUTINE UA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE UA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(UA_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyOtherState' @@ -4527,12 +4469,6 @@ SUBROUTINE UA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OtherStateData%FirstPass)) THEN DEALLOCATE(OtherStateData%FirstPass) ENDIF @@ -4552,7 +4488,7 @@ SUBROUTINE UA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpoin DEALLOCATE(OtherStateData%n) ENDIF DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL UA_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL UA_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO IF (ALLOCATED(OtherStateData%t_vortexBegin)) THEN @@ -5495,14 +5431,12 @@ SUBROUTINE UA_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE UA_CopyMisc - SUBROUTINE UA_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE UA_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(UA_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyMisc' @@ -5510,12 +5444,6 @@ SUBROUTINE UA_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MiscData%TESF)) THEN DEALLOCATE(MiscData%TESF) ENDIF @@ -5993,14 +5921,12 @@ SUBROUTINE UA_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE UA_CopyParam - SUBROUTINE UA_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE UA_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(UA_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyParam' @@ -6008,12 +5934,6 @@ SUBROUTINE UA_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%c)) THEN DEALLOCATE(ParamData%c) ENDIF @@ -6317,14 +6237,12 @@ SUBROUTINE UA_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) DstInputData%omega = SrcInputData%omega END SUBROUTINE UA_CopyInput - SUBROUTINE UA_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE UA_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(UA_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyInput' @@ -6332,12 +6250,6 @@ SUBROUTINE UA_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE UA_DestroyInput SUBROUTINE UA_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -6503,14 +6415,12 @@ SUBROUTINE UA_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs ENDIF END SUBROUTINE UA_CopyOutput - SUBROUTINE UA_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE UA_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(UA_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyOutput' @@ -6518,12 +6428,6 @@ SUBROUTINE UA_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%WriteOutput)) THEN DEALLOCATE(OutputData%WriteOutput) ENDIF diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index 51041bf082..2375d35c70 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -480,7 +480,6 @@ SUBROUTINE AD14_CopyMarker( SrcMarkerData, DstMarkerData, CtrlCode, ErrStat, Err INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyMarker' @@ -493,14 +492,12 @@ SUBROUTINE AD14_CopyMarker( SrcMarkerData, DstMarkerData, CtrlCode, ErrStat, Err DstMarkerData%RotationVel = SrcMarkerData%RotationVel END SUBROUTINE AD14_CopyMarker - SUBROUTINE AD14_DestroyMarker( MarkerData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyMarker( MarkerData, ErrStat, ErrMsg ) TYPE(Marker), INTENT(INOUT) :: MarkerData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyMarker' @@ -508,12 +505,6 @@ SUBROUTINE AD14_DestroyMarker( MarkerData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AD14_DestroyMarker SUBROUTINE AD14_PackMarker( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -617,7 +608,6 @@ SUBROUTINE AD14_UnPackMarker( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: i INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackMarker' @@ -716,14 +706,12 @@ SUBROUTINE AD14_CopyAeroConfig( SrcAeroConfigData, DstAeroConfigData, CtrlCode, DstAeroConfigData%BladeLength = SrcAeroConfigData%BladeLength END SUBROUTINE AD14_CopyAeroConfig - SUBROUTINE AD14_DestroyAeroConfig( AeroConfigData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyAeroConfig( AeroConfigData, ErrStat, ErrMsg ) TYPE(AeroConfig), INTENT(INOUT) :: AeroConfigData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyAeroConfig' @@ -731,32 +719,26 @@ SUBROUTINE AD14_DestroyAeroConfig( AeroConfigData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(AeroConfigData%Blade)) THEN DO i1 = LBOUND(AeroConfigData%Blade,1), UBOUND(AeroConfigData%Blade,1) - CALL AD14_Destroymarker( AeroConfigData%Blade(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyMarker( AeroConfigData%Blade(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(AeroConfigData%Blade) ENDIF - CALL AD14_Destroymarker( AeroConfigData%Hub, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyMarker( AeroConfigData%Hub, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroymarker( AeroConfigData%RotorFurl, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyMarker( AeroConfigData%RotorFurl, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroymarker( AeroConfigData%Nacelle, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyMarker( AeroConfigData%Nacelle, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroymarker( AeroConfigData%TailFin, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyMarker( AeroConfigData%TailFin, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroymarker( AeroConfigData%Tower, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyMarker( AeroConfigData%Tower, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroymarker( AeroConfigData%SubStructure, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyMarker( AeroConfigData%SubStructure, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroymarker( AeroConfigData%Foundation, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyMarker( AeroConfigData%Foundation, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD14_DestroyAeroConfig @@ -801,7 +783,7 @@ SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%Blade,1), UBOUND(InData%Blade,1) Int_BufSz = Int_BufSz + 3 ! Blade: size of buffers for each call to pack subtype - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Blade(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Blade + CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Blade(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Blade CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -820,7 +802,7 @@ SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err END DO END IF Int_BufSz = Int_BufSz + 3 ! Hub: size of buffers for each call to pack subtype - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Hub, ErrStat2, ErrMsg2, .TRUE. ) ! Hub + CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Hub, ErrStat2, ErrMsg2, .TRUE. ) ! Hub CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -837,7 +819,7 @@ SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! RotorFurl: size of buffers for each call to pack subtype - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%RotorFurl, ErrStat2, ErrMsg2, .TRUE. ) ! RotorFurl + CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%RotorFurl, ErrStat2, ErrMsg2, .TRUE. ) ! RotorFurl CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -854,7 +836,7 @@ SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Nacelle: size of buffers for each call to pack subtype - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Nacelle, ErrStat2, ErrMsg2, .TRUE. ) ! Nacelle + CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Nacelle, ErrStat2, ErrMsg2, .TRUE. ) ! Nacelle CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -871,7 +853,7 @@ SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! TailFin: size of buffers for each call to pack subtype - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%TailFin, ErrStat2, ErrMsg2, .TRUE. ) ! TailFin + CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%TailFin, ErrStat2, ErrMsg2, .TRUE. ) ! TailFin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -888,7 +870,7 @@ SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Tower: size of buffers for each call to pack subtype - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Tower, ErrStat2, ErrMsg2, .TRUE. ) ! Tower + CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Tower, ErrStat2, ErrMsg2, .TRUE. ) ! Tower CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -905,7 +887,7 @@ SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! SubStructure: size of buffers for each call to pack subtype - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure, ErrStat2, ErrMsg2, .TRUE. ) ! SubStructure + CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure, ErrStat2, ErrMsg2, .TRUE. ) ! SubStructure CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -922,7 +904,7 @@ SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Foundation: size of buffers for each call to pack subtype - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Foundation, ErrStat2, ErrMsg2, .TRUE. ) ! Foundation + CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Foundation, ErrStat2, ErrMsg2, .TRUE. ) ! Foundation CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -977,7 +959,7 @@ SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%Blade,1), UBOUND(InData%Blade,1) - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Blade(i1), ErrStat2, ErrMsg2, OnlySize ) ! Blade + CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Blade(i1), ErrStat2, ErrMsg2, OnlySize ) ! Blade CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1007,7 +989,7 @@ SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ENDIF END DO END IF - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Hub, ErrStat2, ErrMsg2, OnlySize ) ! Hub + CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Hub, ErrStat2, ErrMsg2, OnlySize ) ! Hub CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1035,7 +1017,7 @@ SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%RotorFurl, ErrStat2, ErrMsg2, OnlySize ) ! RotorFurl + CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%RotorFurl, ErrStat2, ErrMsg2, OnlySize ) ! RotorFurl CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1063,7 +1045,7 @@ SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Nacelle, ErrStat2, ErrMsg2, OnlySize ) ! Nacelle + CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Nacelle, ErrStat2, ErrMsg2, OnlySize ) ! Nacelle CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1091,7 +1073,7 @@ SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%TailFin, ErrStat2, ErrMsg2, OnlySize ) ! TailFin + CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%TailFin, ErrStat2, ErrMsg2, OnlySize ) ! TailFin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1119,7 +1101,7 @@ SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Tower, ErrStat2, ErrMsg2, OnlySize ) ! Tower + CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Tower, ErrStat2, ErrMsg2, OnlySize ) ! Tower CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1147,7 +1129,7 @@ SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure, ErrStat2, ErrMsg2, OnlySize ) ! SubStructure + CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure, ErrStat2, ErrMsg2, OnlySize ) ! SubStructure CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1175,7 +1157,7 @@ SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packmarker( Re_Buf, Db_Buf, Int_Buf, InData%Foundation, ErrStat2, ErrMsg2, OnlySize ) ! Foundation + CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Foundation, ErrStat2, ErrMsg2, OnlySize ) ! Foundation CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1281,7 +1263,7 @@ SUBROUTINE AD14_UnPackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Blade(i1), ErrStat2, ErrMsg2 ) ! Blade + CALL AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%Blade(i1), ErrStat2, ErrMsg2 ) ! Blade CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1323,7 +1305,7 @@ SUBROUTINE AD14_UnPackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Hub, ErrStat2, ErrMsg2 ) ! Hub + CALL AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%Hub, ErrStat2, ErrMsg2 ) ! Hub CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1363,7 +1345,7 @@ SUBROUTINE AD14_UnPackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%RotorFurl, ErrStat2, ErrMsg2 ) ! RotorFurl + CALL AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%RotorFurl, ErrStat2, ErrMsg2 ) ! RotorFurl CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1403,7 +1385,7 @@ SUBROUTINE AD14_UnPackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Nacelle, ErrStat2, ErrMsg2 ) ! Nacelle + CALL AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%Nacelle, ErrStat2, ErrMsg2 ) ! Nacelle CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1443,7 +1425,7 @@ SUBROUTINE AD14_UnPackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%TailFin, ErrStat2, ErrMsg2 ) ! TailFin + CALL AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%TailFin, ErrStat2, ErrMsg2 ) ! TailFin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1483,7 +1465,7 @@ SUBROUTINE AD14_UnPackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Tower, ErrStat2, ErrMsg2 ) ! Tower + CALL AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%Tower, ErrStat2, ErrMsg2 ) ! Tower CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1523,7 +1505,7 @@ SUBROUTINE AD14_UnPackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure, ErrStat2, ErrMsg2 ) ! SubStructure + CALL AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure, ErrStat2, ErrMsg2 ) ! SubStructure CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1563,7 +1545,7 @@ SUBROUTINE AD14_UnPackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackmarker( Re_Buf, Db_Buf, Int_Buf, OutData%Foundation, ErrStat2, ErrMsg2 ) ! Foundation + CALL AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%Foundation, ErrStat2, ErrMsg2 ) ! Foundation CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1657,14 +1639,12 @@ SUBROUTINE AD14_CopyAirFoil( SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, DstAirFoilData%MulTabLoc = SrcAirFoilData%MulTabLoc END SUBROUTINE AD14_CopyAirFoil - SUBROUTINE AD14_DestroyAirFoil( AirFoilData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyAirFoil( AirFoilData, ErrStat, ErrMsg ) TYPE(AirFoil), INTENT(INOUT) :: AirFoilData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyAirFoil' @@ -1672,12 +1652,6 @@ SUBROUTINE AD14_DestroyAirFoil( AirFoilData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(AirFoilData%AL)) THEN DEALLOCATE(AirFoilData%AL) ENDIF @@ -2102,14 +2076,12 @@ SUBROUTINE AD14_CopyAirFoilParms( SrcAirFoilParmsData, DstAirFoilParmsData, Ctrl ENDIF END SUBROUTINE AD14_CopyAirFoilParms - SUBROUTINE AD14_DestroyAirFoilParms( AirFoilParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyAirFoilParms( AirFoilParmsData, ErrStat, ErrMsg ) TYPE(AirFoilParms), INTENT(INOUT) :: AirFoilParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyAirFoilParms' @@ -2117,12 +2089,6 @@ SUBROUTINE AD14_DestroyAirFoilParms( AirFoilParmsData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(AirFoilParmsData%NTables)) THEN DEALLOCATE(AirFoilParmsData%NTables) ENDIF @@ -3217,14 +3183,12 @@ SUBROUTINE AD14_CopyBeddoes( SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, DstBeddoesData%VOR = SrcBeddoesData%VOR END SUBROUTINE AD14_CopyBeddoes - SUBROUTINE AD14_DestroyBeddoes( BeddoesData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyBeddoes( BeddoesData, ErrStat, ErrMsg ) TYPE(Beddoes), INTENT(INOUT) :: BeddoesData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyBeddoes' @@ -3232,12 +3196,6 @@ SUBROUTINE AD14_DestroyBeddoes( BeddoesData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(BeddoesData%ADOT)) THEN DEALLOCATE(BeddoesData%ADOT) ENDIF @@ -6093,14 +6051,12 @@ SUBROUTINE AD14_CopyBeddoesParms( SrcBeddoesParmsData, DstBeddoesParmsData, Ctrl DstBeddoesParmsData%TVL = SrcBeddoesParmsData%TVL END SUBROUTINE AD14_CopyBeddoesParms - SUBROUTINE AD14_DestroyBeddoesParms( BeddoesParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyBeddoesParms( BeddoesParmsData, ErrStat, ErrMsg ) TYPE(BeddoesParms), INTENT(INOUT) :: BeddoesParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyBeddoesParms' @@ -6108,12 +6064,6 @@ SUBROUTINE AD14_DestroyBeddoesParms( BeddoesParmsData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AD14_DestroyBeddoesParms SUBROUTINE AD14_PackBeddoesParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -6276,14 +6226,12 @@ SUBROUTINE AD14_CopyBladeParms( SrcBladeParmsData, DstBladeParmsData, CtrlCode, DstBladeParmsData%BladeLength = SrcBladeParmsData%BladeLength END SUBROUTINE AD14_CopyBladeParms - SUBROUTINE AD14_DestroyBladeParms( BladeParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyBladeParms( BladeParmsData, ErrStat, ErrMsg ) TYPE(BladeParms), INTENT(INOUT) :: BladeParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyBladeParms' @@ -6291,12 +6239,6 @@ SUBROUTINE AD14_DestroyBladeParms( BladeParmsData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(BladeParmsData%C)) THEN DEALLOCATE(BladeParmsData%C) ENDIF @@ -6559,14 +6501,12 @@ SUBROUTINE AD14_CopyDynInflow( SrcDynInflowData, DstDynInflowData, CtrlCode, Err DstDynInflowData%GAMMA = SrcDynInflowData%GAMMA END SUBROUTINE AD14_CopyDynInflow - SUBROUTINE AD14_DestroyDynInflow( DynInflowData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyDynInflow( DynInflowData, ErrStat, ErrMsg ) TYPE(DynInflow), INTENT(INOUT) :: DynInflowData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyDynInflow' @@ -6574,12 +6514,6 @@ SUBROUTINE AD14_DestroyDynInflow( DynInflowData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(DynInflowData%RMC_SAVE)) THEN DEALLOCATE(DynInflowData%RMC_SAVE) ENDIF @@ -7070,14 +7004,12 @@ SUBROUTINE AD14_CopyDynInflowParms( SrcDynInflowParmsData, DstDynInflowParmsData DstDynInflowParmsData%xMinv = SrcDynInflowParmsData%xMinv END SUBROUTINE AD14_CopyDynInflowParms - SUBROUTINE AD14_DestroyDynInflowParms( DynInflowParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyDynInflowParms( DynInflowParmsData, ErrStat, ErrMsg ) TYPE(DynInflowParms), INTENT(INOUT) :: DynInflowParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyDynInflowParms' @@ -7085,12 +7017,6 @@ SUBROUTINE AD14_DestroyDynInflowParms( DynInflowParmsData, ErrStat, ErrMsg, DEAL ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AD14_DestroyDynInflowParms SUBROUTINE AD14_PackDynInflowParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -7318,14 +7244,12 @@ SUBROUTINE AD14_CopyElement( SrcElementData, DstElementData, CtrlCode, ErrStat, ENDIF END SUBROUTINE AD14_CopyElement - SUBROUTINE AD14_DestroyElement( ElementData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyElement( ElementData, ErrStat, ErrMsg ) TYPE(Element), INTENT(INOUT) :: ElementData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyElement' @@ -7333,12 +7257,6 @@ SUBROUTINE AD14_DestroyElement( ElementData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ElementData%A)) THEN DEALLOCATE(ElementData%A) ENDIF @@ -7858,14 +7776,12 @@ SUBROUTINE AD14_CopyElementParms( SrcElementParmsData, DstElementParmsData, Ctrl ENDIF END SUBROUTINE AD14_CopyElementParms - SUBROUTINE AD14_DestroyElementParms( ElementParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyElementParms( ElementParmsData, ErrStat, ErrMsg ) TYPE(ElementParms), INTENT(INOUT) :: ElementParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyElementParms' @@ -7873,12 +7789,6 @@ SUBROUTINE AD14_DestroyElementParms( ElementParmsData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ElementParmsData%TWIST)) THEN DEALLOCATE(ElementParmsData%TWIST) ENDIF @@ -8436,14 +8346,12 @@ SUBROUTINE AD14_CopyElOutParms( SrcElOutParmsData, DstElOutParmsData, CtrlCode, DstElOutParmsData%NumElOut = SrcElOutParmsData%NumElOut END SUBROUTINE AD14_CopyElOutParms - SUBROUTINE AD14_DestroyElOutParms( ElOutParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyElOutParms( ElOutParmsData, ErrStat, ErrMsg ) TYPE(ElOutParms), INTENT(INOUT) :: ElOutParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyElOutParms' @@ -8451,12 +8359,6 @@ SUBROUTINE AD14_DestroyElOutParms( ElOutParmsData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ElOutParmsData%AAA)) THEN DEALLOCATE(ElOutParmsData%AAA) ENDIF @@ -9527,14 +9429,12 @@ SUBROUTINE AD14_CopyInducedVel( SrcInducedVelData, DstInducedVelData, CtrlCode, DstInducedVelData%SumInFl = SrcInducedVelData%SumInFl END SUBROUTINE AD14_CopyInducedVel - SUBROUTINE AD14_DestroyInducedVel( InducedVelData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyInducedVel( InducedVelData, ErrStat, ErrMsg ) TYPE(InducedVel), INTENT(INOUT) :: InducedVelData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInducedVel' @@ -9542,12 +9442,6 @@ SUBROUTINE AD14_DestroyInducedVel( InducedVelData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AD14_DestroyInducedVel SUBROUTINE AD14_PackInducedVel( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -9670,14 +9564,12 @@ SUBROUTINE AD14_CopyInducedVelParms( SrcInducedVelParmsData, DstInducedVelParmsD DstInducedVelParmsData%HLoss = SrcInducedVelParmsData%HLoss END SUBROUTINE AD14_CopyInducedVelParms - SUBROUTINE AD14_DestroyInducedVelParms( InducedVelParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyInducedVelParms( InducedVelParmsData, ErrStat, ErrMsg ) TYPE(InducedVelParms), INTENT(INOUT) :: InducedVelParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInducedVelParms' @@ -9685,12 +9577,6 @@ SUBROUTINE AD14_DestroyInducedVelParms( InducedVelParmsData, ErrStat, ErrMsg, DE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AD14_DestroyInducedVelParms SUBROUTINE AD14_PackInducedVelParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -9845,14 +9731,12 @@ SUBROUTINE AD14_CopyRotor( SrcRotorData, DstRotorData, CtrlCode, ErrStat, ErrMsg DstRotorData%YawVEL = SrcRotorData%YawVEL END SUBROUTINE AD14_CopyRotor - SUBROUTINE AD14_DestroyRotor( RotorData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyRotor( RotorData, ErrStat, ErrMsg ) TYPE(Rotor), INTENT(INOUT) :: RotorData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyRotor' @@ -9860,12 +9744,6 @@ SUBROUTINE AD14_DestroyRotor( RotorData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AD14_DestroyRotor SUBROUTINE AD14_PackRotor( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -10022,14 +9900,12 @@ SUBROUTINE AD14_CopyRotorParms( SrcRotorParmsData, DstRotorParmsData, CtrlCode, DstRotorParmsData%HH = SrcRotorParmsData%HH END SUBROUTINE AD14_CopyRotorParms - SUBROUTINE AD14_DestroyRotorParms( RotorParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyRotorParms( RotorParmsData, ErrStat, ErrMsg ) TYPE(RotorParms), INTENT(INOUT) :: RotorParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyRotorParms' @@ -10037,12 +9913,6 @@ SUBROUTINE AD14_DestroyRotorParms( RotorParmsData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AD14_DestroyRotorParms SUBROUTINE AD14_PackRotorParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -10250,14 +10120,12 @@ SUBROUTINE AD14_CopyTwrPropsParms( SrcTwrPropsParmsData, DstTwrPropsParmsData, C ENDIF END SUBROUTINE AD14_CopyTwrPropsParms - SUBROUTINE AD14_DestroyTwrPropsParms( TwrPropsParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyTwrPropsParms( TwrPropsParmsData, ErrStat, ErrMsg ) TYPE(TwrPropsParms), INTENT(INOUT) :: TwrPropsParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyTwrPropsParms' @@ -10265,12 +10133,6 @@ SUBROUTINE AD14_DestroyTwrPropsParms( TwrPropsParmsData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(TwrPropsParmsData%TwrHtFr)) THEN DEALLOCATE(TwrPropsParmsData%TwrHtFr) ENDIF @@ -10735,14 +10597,12 @@ SUBROUTINE AD14_CopyWind( SrcWindData, DstWindData, CtrlCode, ErrStat, ErrMsg ) DstWindData%SDEL = SrcWindData%SDEL END SUBROUTINE AD14_CopyWind - SUBROUTINE AD14_DestroyWind( WindData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyWind( WindData, ErrStat, ErrMsg ) TYPE(Wind), INTENT(INOUT) :: WindData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyWind' @@ -10750,12 +10610,6 @@ SUBROUTINE AD14_DestroyWind( WindData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AD14_DestroyWind SUBROUTINE AD14_PackWind( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -10898,14 +10752,12 @@ SUBROUTINE AD14_CopyWindParms( SrcWindParmsData, DstWindParmsData, CtrlCode, Err DstWindParmsData%KinVisc = SrcWindParmsData%KinVisc END SUBROUTINE AD14_CopyWindParms - SUBROUTINE AD14_DestroyWindParms( WindParmsData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyWindParms( WindParmsData, ErrStat, ErrMsg ) TYPE(WindParms), INTENT(INOUT) :: WindParmsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyWindParms' @@ -10913,12 +10765,6 @@ SUBROUTINE AD14_DestroyWindParms( WindParmsData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AD14_DestroyWindParms SUBROUTINE AD14_PackWindParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -11041,14 +10887,12 @@ SUBROUTINE AD14_CopyPositionType( SrcPositionTypeData, DstPositionTypeData, Ctrl DstPositionTypeData%Pos = SrcPositionTypeData%Pos END SUBROUTINE AD14_CopyPositionType - SUBROUTINE AD14_DestroyPositionType( PositionTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyPositionType( PositionTypeData, ErrStat, ErrMsg ) TYPE(PositionType), INTENT(INOUT) :: PositionTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyPositionType' @@ -11056,12 +10900,6 @@ SUBROUTINE AD14_DestroyPositionType( PositionTypeData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AD14_DestroyPositionType SUBROUTINE AD14_PackPositionType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -11187,14 +11025,12 @@ SUBROUTINE AD14_CopyOrientationType( SrcOrientationTypeData, DstOrientationTypeD DstOrientationTypeData%Orient = SrcOrientationTypeData%Orient END SUBROUTINE AD14_CopyOrientationType - SUBROUTINE AD14_DestroyOrientationType( OrientationTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyOrientationType( OrientationTypeData, ErrStat, ErrMsg ) TYPE(OrientationType), INTENT(INOUT) :: OrientationTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyOrientationType' @@ -11202,12 +11038,6 @@ SUBROUTINE AD14_DestroyOrientationType( OrientationTypeData, ErrStat, ErrMsg, DE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE AD14_DestroyOrientationType SUBROUTINE AD14_PackOrientationType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -11369,14 +11199,12 @@ SUBROUTINE AD14_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD14_CopyInitInput - SUBROUTINE AD14_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(AD14_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInitInput' @@ -11384,18 +11212,12 @@ SUBROUTINE AD14_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD14_Destroyaeroconfig( InitInputData%TurbineComponents, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyAeroConfig( InitInputData%TurbineComponents, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitInputData%TwrNodeLocs)) THEN DEALLOCATE(InitInputData%TwrNodeLocs) ENDIF - CALL DWM_DestroyInitInput( InitInputData%DWM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_DestroyInitInput( InitInputData%DWM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD14_DestroyInitInput @@ -11444,7 +11266,7 @@ SUBROUTINE AD14_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_BufSz = Int_BufSz + 1 ! UseDWM ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! TurbineComponents: size of buffers for each call to pack subtype - CALL AD14_Packaeroconfig( Re_Buf, Db_Buf, Int_Buf, InData%TurbineComponents, ErrStat2, ErrMsg2, .TRUE. ) ! TurbineComponents + CALL AD14_PackAeroConfig( Re_Buf, Db_Buf, Int_Buf, InData%TurbineComponents, ErrStat2, ErrMsg2, .TRUE. ) ! TurbineComponents CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11533,7 +11355,7 @@ SUBROUTINE AD14_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%UseDWM, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - CALL AD14_Packaeroconfig( Re_Buf, Db_Buf, Int_Buf, InData%TurbineComponents, ErrStat2, ErrMsg2, OnlySize ) ! TurbineComponents + CALL AD14_PackAeroConfig( Re_Buf, Db_Buf, Int_Buf, InData%TurbineComponents, ErrStat2, ErrMsg2, OnlySize ) ! TurbineComponents CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11698,7 +11520,7 @@ SUBROUTINE AD14_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackaeroconfig( Re_Buf, Db_Buf, Int_Buf, OutData%TurbineComponents, ErrStat2, ErrMsg2 ) ! TurbineComponents + CALL AD14_UnpackAeroConfig( Re_Buf, Db_Buf, Int_Buf, OutData%TurbineComponents, ErrStat2, ErrMsg2 ) ! TurbineComponents CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11797,14 +11619,12 @@ SUBROUTINE AD14_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%AirDens = SrcInitOutputData%AirDens END SUBROUTINE AD14_CopyInitOutput - SUBROUTINE AD14_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(AD14_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInitOutput' @@ -11812,15 +11632,9 @@ SUBROUTINE AD14_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyInitOutput( InitOutputData%DWM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_DestroyInitOutput( InitOutputData%DWM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD14_DestroyInitOutput @@ -11861,7 +11675,7 @@ SUBROUTINE AD14_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11922,7 +11736,7 @@ SUBROUTINE AD14_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12041,7 +11855,7 @@ SUBROUTINE AD14_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12111,14 +11925,12 @@ SUBROUTINE AD14_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD14_CopyContState - SUBROUTINE AD14_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(AD14_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyContState' @@ -12126,13 +11938,7 @@ SUBROUTINE AD14_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL DWM_DestroyContState( ContStateData%DWM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_DestroyContState( ContStateData%DWM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD14_DestroyContState @@ -12333,14 +12139,12 @@ SUBROUTINE AD14_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD14_CopyDiscState - SUBROUTINE AD14_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(AD14_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyDiscState' @@ -12348,13 +12152,7 @@ SUBROUTINE AD14_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL DWM_DestroyDiscState( DiscStateData%DWM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_DestroyDiscState( DiscStateData%DWM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD14_DestroyDiscState @@ -12555,14 +12353,12 @@ SUBROUTINE AD14_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCod IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD14_CopyConstrState - SUBROUTINE AD14_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(AD14_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyConstrState' @@ -12570,13 +12366,7 @@ SUBROUTINE AD14_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL DWM_DestroyConstrState( ConstrStateData%DWM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_DestroyConstrState( ConstrStateData%DWM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD14_DestroyConstrState @@ -12777,14 +12567,12 @@ SUBROUTINE AD14_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD14_CopyOtherState - SUBROUTINE AD14_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(AD14_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyOtherState' @@ -12792,13 +12580,7 @@ SUBROUTINE AD14_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL DWM_DestroyOtherState( OtherStateData%DWM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_DestroyOtherState( OtherStateData%DWM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD14_DestroyOtherState @@ -13092,14 +12874,12 @@ SUBROUTINE AD14_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD14_CopyMisc - SUBROUTINE AD14_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(AD14_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyMisc' @@ -13107,36 +12887,30 @@ SUBROUTINE AD14_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL DWM_DestroyMisc( MiscData%DWM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_DestroyMisc( MiscData%DWM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyInput( MiscData%DWM_Inputs, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_DestroyInput( MiscData%DWM_Inputs, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyOutput( MiscData%DWM_Outputs, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_DestroyOutput( MiscData%DWM_Outputs, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MiscData%ElPrNum)) THEN DEALLOCATE(MiscData%ElPrNum) ENDIF - CALL AD14_Destroyairfoil( MiscData%AirFoil, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyAirFoil( MiscData%AirFoil, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroybeddoes( MiscData%Beddoes, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyBeddoes( MiscData%Beddoes, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroydyninflow( MiscData%DynInflow, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyDynInflow( MiscData%DynInflow, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroyelement( MiscData%Element, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyElement( MiscData%Element, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroyrotor( MiscData%Rotor, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyRotor( MiscData%Rotor, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroywind( MiscData%Wind, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyWind( MiscData%Wind, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroyinducedvel( MiscData%InducedVel, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyInducedVel( MiscData%InducedVel, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroyeloutparms( MiscData%ElOut, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyElOutParms( MiscData%ElOut, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MiscData%StoredForces)) THEN DEALLOCATE(MiscData%StoredForces) @@ -13252,7 +13026,7 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_BufSz = Int_BufSz + 1 ! NoLoadsCalculated Int_BufSz = Int_BufSz + 1 ! NERRORS Int_BufSz = Int_BufSz + 3 ! AirFoil: size of buffers for each call to pack subtype - CALL AD14_Packairfoil( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, .TRUE. ) ! AirFoil + CALL AD14_PackAirFoil( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, .TRUE. ) ! AirFoil CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13269,7 +13043,7 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Beddoes: size of buffers for each call to pack subtype - CALL AD14_Packbeddoes( Re_Buf, Db_Buf, Int_Buf, InData%Beddoes, ErrStat2, ErrMsg2, .TRUE. ) ! Beddoes + CALL AD14_PackBeddoes( Re_Buf, Db_Buf, Int_Buf, InData%Beddoes, ErrStat2, ErrMsg2, .TRUE. ) ! Beddoes CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13286,7 +13060,7 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! DynInflow: size of buffers for each call to pack subtype - CALL AD14_Packdyninflow( Re_Buf, Db_Buf, Int_Buf, InData%DynInflow, ErrStat2, ErrMsg2, .TRUE. ) ! DynInflow + CALL AD14_PackDynInflow( Re_Buf, Db_Buf, Int_Buf, InData%DynInflow, ErrStat2, ErrMsg2, .TRUE. ) ! DynInflow CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13303,7 +13077,7 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Element: size of buffers for each call to pack subtype - CALL AD14_Packelement( Re_Buf, Db_Buf, Int_Buf, InData%Element, ErrStat2, ErrMsg2, .TRUE. ) ! Element + CALL AD14_PackElement( Re_Buf, Db_Buf, Int_Buf, InData%Element, ErrStat2, ErrMsg2, .TRUE. ) ! Element CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13320,7 +13094,7 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Rotor: size of buffers for each call to pack subtype - CALL AD14_Packrotor( Re_Buf, Db_Buf, Int_Buf, InData%Rotor, ErrStat2, ErrMsg2, .TRUE. ) ! Rotor + CALL AD14_PackRotor( Re_Buf, Db_Buf, Int_Buf, InData%Rotor, ErrStat2, ErrMsg2, .TRUE. ) ! Rotor CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13337,7 +13111,7 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Wind: size of buffers for each call to pack subtype - CALL AD14_Packwind( Re_Buf, Db_Buf, Int_Buf, InData%Wind, ErrStat2, ErrMsg2, .TRUE. ) ! Wind + CALL AD14_PackWind( Re_Buf, Db_Buf, Int_Buf, InData%Wind, ErrStat2, ErrMsg2, .TRUE. ) ! Wind CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13354,7 +13128,7 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! InducedVel: size of buffers for each call to pack subtype - CALL AD14_Packinducedvel( Re_Buf, Db_Buf, Int_Buf, InData%InducedVel, ErrStat2, ErrMsg2, .TRUE. ) ! InducedVel + CALL AD14_PackInducedVel( Re_Buf, Db_Buf, Int_Buf, InData%InducedVel, ErrStat2, ErrMsg2, .TRUE. ) ! InducedVel CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13371,7 +13145,7 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! ElOut: size of buffers for each call to pack subtype - CALL AD14_Packeloutparms( Re_Buf, Db_Buf, Int_Buf, InData%ElOut, ErrStat2, ErrMsg2, .TRUE. ) ! ElOut + CALL AD14_PackElOutParms( Re_Buf, Db_Buf, Int_Buf, InData%ElOut, ErrStat2, ErrMsg2, .TRUE. ) ! ElOut CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13552,7 +13326,7 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%NERRORS Int_Xferred = Int_Xferred + 1 - CALL AD14_Packairfoil( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, OnlySize ) ! AirFoil + CALL AD14_PackAirFoil( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, OnlySize ) ! AirFoil CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13580,7 +13354,7 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packbeddoes( Re_Buf, Db_Buf, Int_Buf, InData%Beddoes, ErrStat2, ErrMsg2, OnlySize ) ! Beddoes + CALL AD14_PackBeddoes( Re_Buf, Db_Buf, Int_Buf, InData%Beddoes, ErrStat2, ErrMsg2, OnlySize ) ! Beddoes CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13608,7 +13382,7 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packdyninflow( Re_Buf, Db_Buf, Int_Buf, InData%DynInflow, ErrStat2, ErrMsg2, OnlySize ) ! DynInflow + CALL AD14_PackDynInflow( Re_Buf, Db_Buf, Int_Buf, InData%DynInflow, ErrStat2, ErrMsg2, OnlySize ) ! DynInflow CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13636,7 +13410,7 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packelement( Re_Buf, Db_Buf, Int_Buf, InData%Element, ErrStat2, ErrMsg2, OnlySize ) ! Element + CALL AD14_PackElement( Re_Buf, Db_Buf, Int_Buf, InData%Element, ErrStat2, ErrMsg2, OnlySize ) ! Element CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13664,7 +13438,7 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packrotor( Re_Buf, Db_Buf, Int_Buf, InData%Rotor, ErrStat2, ErrMsg2, OnlySize ) ! Rotor + CALL AD14_PackRotor( Re_Buf, Db_Buf, Int_Buf, InData%Rotor, ErrStat2, ErrMsg2, OnlySize ) ! Rotor CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13692,7 +13466,7 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packwind( Re_Buf, Db_Buf, Int_Buf, InData%Wind, ErrStat2, ErrMsg2, OnlySize ) ! Wind + CALL AD14_PackWind( Re_Buf, Db_Buf, Int_Buf, InData%Wind, ErrStat2, ErrMsg2, OnlySize ) ! Wind CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13720,7 +13494,7 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packinducedvel( Re_Buf, Db_Buf, Int_Buf, InData%InducedVel, ErrStat2, ErrMsg2, OnlySize ) ! InducedVel + CALL AD14_PackInducedVel( Re_Buf, Db_Buf, Int_Buf, InData%InducedVel, ErrStat2, ErrMsg2, OnlySize ) ! InducedVel CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13748,7 +13522,7 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packeloutparms( Re_Buf, Db_Buf, Int_Buf, InData%ElOut, ErrStat2, ErrMsg2, OnlySize ) ! ElOut + CALL AD14_PackElOutParms( Re_Buf, Db_Buf, Int_Buf, InData%ElOut, ErrStat2, ErrMsg2, OnlySize ) ! ElOut CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14060,7 +13834,7 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackairfoil( Re_Buf, Db_Buf, Int_Buf, OutData%AirFoil, ErrStat2, ErrMsg2 ) ! AirFoil + CALL AD14_UnpackAirFoil( Re_Buf, Db_Buf, Int_Buf, OutData%AirFoil, ErrStat2, ErrMsg2 ) ! AirFoil CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14100,7 +13874,7 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackbeddoes( Re_Buf, Db_Buf, Int_Buf, OutData%Beddoes, ErrStat2, ErrMsg2 ) ! Beddoes + CALL AD14_UnpackBeddoes( Re_Buf, Db_Buf, Int_Buf, OutData%Beddoes, ErrStat2, ErrMsg2 ) ! Beddoes CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14140,7 +13914,7 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackdyninflow( Re_Buf, Db_Buf, Int_Buf, OutData%DynInflow, ErrStat2, ErrMsg2 ) ! DynInflow + CALL AD14_UnpackDynInflow( Re_Buf, Db_Buf, Int_Buf, OutData%DynInflow, ErrStat2, ErrMsg2 ) ! DynInflow CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14180,7 +13954,7 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackelement( Re_Buf, Db_Buf, Int_Buf, OutData%Element, ErrStat2, ErrMsg2 ) ! Element + CALL AD14_UnpackElement( Re_Buf, Db_Buf, Int_Buf, OutData%Element, ErrStat2, ErrMsg2 ) ! Element CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14220,7 +13994,7 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackrotor( Re_Buf, Db_Buf, Int_Buf, OutData%Rotor, ErrStat2, ErrMsg2 ) ! Rotor + CALL AD14_UnpackRotor( Re_Buf, Db_Buf, Int_Buf, OutData%Rotor, ErrStat2, ErrMsg2 ) ! Rotor CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14260,7 +14034,7 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackwind( Re_Buf, Db_Buf, Int_Buf, OutData%Wind, ErrStat2, ErrMsg2 ) ! Wind + CALL AD14_UnpackWind( Re_Buf, Db_Buf, Int_Buf, OutData%Wind, ErrStat2, ErrMsg2 ) ! Wind CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14300,7 +14074,7 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackinducedvel( Re_Buf, Db_Buf, Int_Buf, OutData%InducedVel, ErrStat2, ErrMsg2 ) ! InducedVel + CALL AD14_UnpackInducedVel( Re_Buf, Db_Buf, Int_Buf, OutData%InducedVel, ErrStat2, ErrMsg2 ) ! InducedVel CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14340,7 +14114,7 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackeloutparms( Re_Buf, Db_Buf, Int_Buf, OutData%ElOut, ErrStat2, ErrMsg2 ) ! ElOut + CALL AD14_UnpackElOutParms( Re_Buf, Db_Buf, Int_Buf, OutData%ElOut, ErrStat2, ErrMsg2 ) ! ElOut CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14482,14 +14256,12 @@ SUBROUTINE AD14_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD14_CopyParam - SUBROUTINE AD14_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(AD14_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyParam' @@ -14497,31 +14269,25 @@ SUBROUTINE AD14_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AD14_Destroyairfoilparms( ParamData%AirFoil, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyAirFoilParms( ParamData%AirFoil, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroybladeparms( ParamData%Blade, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyBladeParms( ParamData%Blade, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroybeddoesparms( ParamData%Beddoes, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyBeddoesParms( ParamData%Beddoes, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroydyninflowparms( ParamData%DynInflow, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyDynInflowParms( ParamData%DynInflow, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroyelementparms( ParamData%Element, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyElementParms( ParamData%Element, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroytwrpropsparms( ParamData%TwrProps, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyTwrPropsParms( ParamData%TwrProps, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroyinducedvelparms( ParamData%InducedVel, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyInducedVelParms( ParamData%InducedVel, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroywindparms( ParamData%Wind, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyWindParms( ParamData%Wind, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroyrotorparms( ParamData%Rotor, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyRotorParms( ParamData%Rotor, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyParam( ParamData%DWM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_DestroyParam( ParamData%DWM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD14_DestroyParam @@ -14587,7 +14353,7 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 1 ! DEFAULT_Wind ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! AirFoil: size of buffers for each call to pack subtype - CALL AD14_Packairfoilparms( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, .TRUE. ) ! AirFoil + CALL AD14_PackAirFoilParms( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, .TRUE. ) ! AirFoil CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14604,7 +14370,7 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Blade: size of buffers for each call to pack subtype - CALL AD14_Packbladeparms( Re_Buf, Db_Buf, Int_Buf, InData%Blade, ErrStat2, ErrMsg2, .TRUE. ) ! Blade + CALL AD14_PackBladeParms( Re_Buf, Db_Buf, Int_Buf, InData%Blade, ErrStat2, ErrMsg2, .TRUE. ) ! Blade CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14621,7 +14387,7 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Beddoes: size of buffers for each call to pack subtype - CALL AD14_Packbeddoesparms( Re_Buf, Db_Buf, Int_Buf, InData%Beddoes, ErrStat2, ErrMsg2, .TRUE. ) ! Beddoes + CALL AD14_PackBeddoesParms( Re_Buf, Db_Buf, Int_Buf, InData%Beddoes, ErrStat2, ErrMsg2, .TRUE. ) ! Beddoes CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14638,7 +14404,7 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! DynInflow: size of buffers for each call to pack subtype - CALL AD14_Packdyninflowparms( Re_Buf, Db_Buf, Int_Buf, InData%DynInflow, ErrStat2, ErrMsg2, .TRUE. ) ! DynInflow + CALL AD14_PackDynInflowParms( Re_Buf, Db_Buf, Int_Buf, InData%DynInflow, ErrStat2, ErrMsg2, .TRUE. ) ! DynInflow CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14655,7 +14421,7 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Element: size of buffers for each call to pack subtype - CALL AD14_Packelementparms( Re_Buf, Db_Buf, Int_Buf, InData%Element, ErrStat2, ErrMsg2, .TRUE. ) ! Element + CALL AD14_PackElementParms( Re_Buf, Db_Buf, Int_Buf, InData%Element, ErrStat2, ErrMsg2, .TRUE. ) ! Element CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14672,7 +14438,7 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! TwrProps: size of buffers for each call to pack subtype - CALL AD14_Packtwrpropsparms( Re_Buf, Db_Buf, Int_Buf, InData%TwrProps, ErrStat2, ErrMsg2, .TRUE. ) ! TwrProps + CALL AD14_PackTwrPropsParms( Re_Buf, Db_Buf, Int_Buf, InData%TwrProps, ErrStat2, ErrMsg2, .TRUE. ) ! TwrProps CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14689,7 +14455,7 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! InducedVel: size of buffers for each call to pack subtype - CALL AD14_Packinducedvelparms( Re_Buf, Db_Buf, Int_Buf, InData%InducedVel, ErrStat2, ErrMsg2, .TRUE. ) ! InducedVel + CALL AD14_PackInducedVelParms( Re_Buf, Db_Buf, Int_Buf, InData%InducedVel, ErrStat2, ErrMsg2, .TRUE. ) ! InducedVel CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14706,7 +14472,7 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Wind: size of buffers for each call to pack subtype - CALL AD14_Packwindparms( Re_Buf, Db_Buf, Int_Buf, InData%Wind, ErrStat2, ErrMsg2, .TRUE. ) ! Wind + CALL AD14_PackWindParms( Re_Buf, Db_Buf, Int_Buf, InData%Wind, ErrStat2, ErrMsg2, .TRUE. ) ! Wind CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14723,7 +14489,7 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Rotor: size of buffers for each call to pack subtype - CALL AD14_Packrotorparms( Re_Buf, Db_Buf, Int_Buf, InData%Rotor, ErrStat2, ErrMsg2, .TRUE. ) ! Rotor + CALL AD14_PackRotorParms( Re_Buf, Db_Buf, Int_Buf, InData%Rotor, ErrStat2, ErrMsg2, .TRUE. ) ! Rotor CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14835,7 +14601,7 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%DEFAULT_Wind Int_Xferred = Int_Xferred + 1 - CALL AD14_Packairfoilparms( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, OnlySize ) ! AirFoil + CALL AD14_PackAirFoilParms( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, OnlySize ) ! AirFoil CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14863,7 +14629,7 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packbladeparms( Re_Buf, Db_Buf, Int_Buf, InData%Blade, ErrStat2, ErrMsg2, OnlySize ) ! Blade + CALL AD14_PackBladeParms( Re_Buf, Db_Buf, Int_Buf, InData%Blade, ErrStat2, ErrMsg2, OnlySize ) ! Blade CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14891,7 +14657,7 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packbeddoesparms( Re_Buf, Db_Buf, Int_Buf, InData%Beddoes, ErrStat2, ErrMsg2, OnlySize ) ! Beddoes + CALL AD14_PackBeddoesParms( Re_Buf, Db_Buf, Int_Buf, InData%Beddoes, ErrStat2, ErrMsg2, OnlySize ) ! Beddoes CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14919,7 +14685,7 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packdyninflowparms( Re_Buf, Db_Buf, Int_Buf, InData%DynInflow, ErrStat2, ErrMsg2, OnlySize ) ! DynInflow + CALL AD14_PackDynInflowParms( Re_Buf, Db_Buf, Int_Buf, InData%DynInflow, ErrStat2, ErrMsg2, OnlySize ) ! DynInflow CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14947,7 +14713,7 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packelementparms( Re_Buf, Db_Buf, Int_Buf, InData%Element, ErrStat2, ErrMsg2, OnlySize ) ! Element + CALL AD14_PackElementParms( Re_Buf, Db_Buf, Int_Buf, InData%Element, ErrStat2, ErrMsg2, OnlySize ) ! Element CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14975,7 +14741,7 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packtwrpropsparms( Re_Buf, Db_Buf, Int_Buf, InData%TwrProps, ErrStat2, ErrMsg2, OnlySize ) ! TwrProps + CALL AD14_PackTwrPropsParms( Re_Buf, Db_Buf, Int_Buf, InData%TwrProps, ErrStat2, ErrMsg2, OnlySize ) ! TwrProps CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15003,7 +14769,7 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packinducedvelparms( Re_Buf, Db_Buf, Int_Buf, InData%InducedVel, ErrStat2, ErrMsg2, OnlySize ) ! InducedVel + CALL AD14_PackInducedVelParms( Re_Buf, Db_Buf, Int_Buf, InData%InducedVel, ErrStat2, ErrMsg2, OnlySize ) ! InducedVel CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15031,7 +14797,7 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packwindparms( Re_Buf, Db_Buf, Int_Buf, InData%Wind, ErrStat2, ErrMsg2, OnlySize ) ! Wind + CALL AD14_PackWindParms( Re_Buf, Db_Buf, Int_Buf, InData%Wind, ErrStat2, ErrMsg2, OnlySize ) ! Wind CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15059,7 +14825,7 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packrotorparms( Re_Buf, Db_Buf, Int_Buf, InData%Rotor, ErrStat2, ErrMsg2, OnlySize ) ! Rotor + CALL AD14_PackRotorParms( Re_Buf, Db_Buf, Int_Buf, InData%Rotor, ErrStat2, ErrMsg2, OnlySize ) ! Rotor CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15228,7 +14994,7 @@ SUBROUTINE AD14_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackairfoilparms( Re_Buf, Db_Buf, Int_Buf, OutData%AirFoil, ErrStat2, ErrMsg2 ) ! AirFoil + CALL AD14_UnpackAirFoilParms( Re_Buf, Db_Buf, Int_Buf, OutData%AirFoil, ErrStat2, ErrMsg2 ) ! AirFoil CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15268,7 +15034,7 @@ SUBROUTINE AD14_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackbladeparms( Re_Buf, Db_Buf, Int_Buf, OutData%Blade, ErrStat2, ErrMsg2 ) ! Blade + CALL AD14_UnpackBladeParms( Re_Buf, Db_Buf, Int_Buf, OutData%Blade, ErrStat2, ErrMsg2 ) ! Blade CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15308,7 +15074,7 @@ SUBROUTINE AD14_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackbeddoesparms( Re_Buf, Db_Buf, Int_Buf, OutData%Beddoes, ErrStat2, ErrMsg2 ) ! Beddoes + CALL AD14_UnpackBeddoesParms( Re_Buf, Db_Buf, Int_Buf, OutData%Beddoes, ErrStat2, ErrMsg2 ) ! Beddoes CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15348,7 +15114,7 @@ SUBROUTINE AD14_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackdyninflowparms( Re_Buf, Db_Buf, Int_Buf, OutData%DynInflow, ErrStat2, ErrMsg2 ) ! DynInflow + CALL AD14_UnpackDynInflowParms( Re_Buf, Db_Buf, Int_Buf, OutData%DynInflow, ErrStat2, ErrMsg2 ) ! DynInflow CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15388,7 +15154,7 @@ SUBROUTINE AD14_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackelementparms( Re_Buf, Db_Buf, Int_Buf, OutData%Element, ErrStat2, ErrMsg2 ) ! Element + CALL AD14_UnpackElementParms( Re_Buf, Db_Buf, Int_Buf, OutData%Element, ErrStat2, ErrMsg2 ) ! Element CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15428,7 +15194,7 @@ SUBROUTINE AD14_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpacktwrpropsparms( Re_Buf, Db_Buf, Int_Buf, OutData%TwrProps, ErrStat2, ErrMsg2 ) ! TwrProps + CALL AD14_UnpackTwrPropsParms( Re_Buf, Db_Buf, Int_Buf, OutData%TwrProps, ErrStat2, ErrMsg2 ) ! TwrProps CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15468,7 +15234,7 @@ SUBROUTINE AD14_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackinducedvelparms( Re_Buf, Db_Buf, Int_Buf, OutData%InducedVel, ErrStat2, ErrMsg2 ) ! InducedVel + CALL AD14_UnpackInducedVelParms( Re_Buf, Db_Buf, Int_Buf, OutData%InducedVel, ErrStat2, ErrMsg2 ) ! InducedVel CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15508,7 +15274,7 @@ SUBROUTINE AD14_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackwindparms( Re_Buf, Db_Buf, Int_Buf, OutData%Wind, ErrStat2, ErrMsg2 ) ! Wind + CALL AD14_UnpackWindParms( Re_Buf, Db_Buf, Int_Buf, OutData%Wind, ErrStat2, ErrMsg2 ) ! Wind CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15548,7 +15314,7 @@ SUBROUTINE AD14_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackrotorparms( Re_Buf, Db_Buf, Int_Buf, OutData%Rotor, ErrStat2, ErrMsg2 ) ! Rotor + CALL AD14_UnpackRotorParms( Re_Buf, Db_Buf, Int_Buf, OutData%Rotor, ErrStat2, ErrMsg2 ) ! Rotor CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15666,14 +15432,12 @@ SUBROUTINE AD14_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg DstInputData%AvgInfVel = SrcInputData%AvgInfVel END SUBROUTINE AD14_CopyInput - SUBROUTINE AD14_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(AD14_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInput' @@ -15681,12 +15445,6 @@ SUBROUTINE AD14_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputData%InputMarkers)) THEN DO i1 = LBOUND(InputData%InputMarkers,1), UBOUND(InputData%InputMarkers,1) CALL MeshDestroy( InputData%InputMarkers(i1), ErrStat2, ErrMsg2 ) @@ -15696,7 +15454,7 @@ SUBROUTINE AD14_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF CALL MeshDestroy( InputData%Twr_InputMarkers, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_Destroyaeroconfig( InputData%TurbineComponents, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyAeroConfig( InputData%TurbineComponents, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InputData%MulTabLoc)) THEN DEALLOCATE(InputData%MulTabLoc) @@ -15783,7 +15541,7 @@ SUBROUTINE AD14_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! TurbineComponents: size of buffers for each call to pack subtype - CALL AD14_Packaeroconfig( Re_Buf, Db_Buf, Int_Buf, InData%TurbineComponents, ErrStat2, ErrMsg2, .TRUE. ) ! TurbineComponents + CALL AD14_PackAeroConfig( Re_Buf, Db_Buf, Int_Buf, InData%TurbineComponents, ErrStat2, ErrMsg2, .TRUE. ) ! TurbineComponents CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15906,7 +15664,7 @@ SUBROUTINE AD14_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL AD14_Packaeroconfig( Re_Buf, Db_Buf, Int_Buf, InData%TurbineComponents, ErrStat2, ErrMsg2, OnlySize ) ! TurbineComponents + CALL AD14_PackAeroConfig( Re_Buf, Db_Buf, Int_Buf, InData%TurbineComponents, ErrStat2, ErrMsg2, OnlySize ) ! TurbineComponents CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -16137,7 +15895,7 @@ SUBROUTINE AD14_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_Unpackaeroconfig( Re_Buf, Db_Buf, Int_Buf, OutData%TurbineComponents, ErrStat2, ErrMsg2 ) ! TurbineComponents + CALL AD14_UnpackAeroConfig( Re_Buf, Db_Buf, Int_Buf, OutData%TurbineComponents, ErrStat2, ErrMsg2 ) ! TurbineComponents CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -16234,14 +15992,12 @@ SUBROUTINE AD14_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AD14_CopyOutput - SUBROUTINE AD14_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AD14_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(AD14_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyOutput' @@ -16249,12 +16005,6 @@ SUBROUTINE AD14_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%OutputLoads)) THEN DO i1 = LBOUND(OutputData%OutputLoads,1), UBOUND(OutputData%OutputLoads,1) CALL MeshDestroy( OutputData%OutputLoads(i1), ErrStat2, ErrMsg2 ) diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 index 9e6784c86a..fc07b27626 100644 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ b/modules/aerodyn14/src/DWM_Types.f90 @@ -334,10 +334,6 @@ SUBROUTINE DWM_CopyCVSD( SrcCVSDData, DstCVSDData, CtrlCode, ErrStat, ErrMsg ) CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyCVSD' @@ -349,14 +345,12 @@ SUBROUTINE DWM_CopyCVSD( SrcCVSDData, DstCVSDData, CtrlCode, ErrStat, ErrMsg ) DstCVSDData%Numerator = SrcCVSDData%Numerator END SUBROUTINE DWM_CopyCVSD - SUBROUTINE DWM_DestroyCVSD( CVSDData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_DestroyCVSD( CVSDData, ErrStat, ErrMsg ) TYPE(CVSD), INTENT(INOUT) :: CVSDData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyCVSD' @@ -364,12 +358,6 @@ SUBROUTINE DWM_DestroyCVSD( CVSDData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE DWM_DestroyCVSD SUBROUTINE DWM_PackCVSD( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -458,10 +446,6 @@ SUBROUTINE DWM_UnPackCVSD( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackCVSD' @@ -551,14 +535,12 @@ SUBROUTINE DWM_Copyturbine_average_velocity_data( Srcturbine_average_velocity_da Dstturbine_average_velocity_dataData%time_step_force = Srcturbine_average_velocity_dataData%time_step_force END SUBROUTINE DWM_Copyturbine_average_velocity_data - SUBROUTINE DWM_Destroyturbine_average_velocity_data( turbine_average_velocity_dataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_Destroyturbine_average_velocity_data( turbine_average_velocity_dataData, ErrStat, ErrMsg ) TYPE(turbine_average_velocity_data), INTENT(INOUT) :: turbine_average_velocity_dataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroyturbine_average_velocity_data' @@ -566,12 +548,6 @@ SUBROUTINE DWM_Destroyturbine_average_velocity_data( turbine_average_velocity_da ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(turbine_average_velocity_dataData%average_velocity_array_temp)) THEN DEALLOCATE(turbine_average_velocity_dataData%average_velocity_array_temp) ENDIF @@ -883,14 +859,12 @@ SUBROUTINE DWM_CopyWake_Deficit_Data( SrcWake_Deficit_DataData, DstWake_Deficit_ DstWake_Deficit_DataData%ppR = SrcWake_Deficit_DataData%ppR END SUBROUTINE DWM_CopyWake_Deficit_Data - SUBROUTINE DWM_DestroyWake_Deficit_Data( Wake_Deficit_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_DestroyWake_Deficit_Data( Wake_Deficit_DataData, ErrStat, ErrMsg ) TYPE(DWM_Wake_Deficit_Data), INTENT(INOUT) :: Wake_Deficit_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyWake_Deficit_Data' @@ -898,12 +872,6 @@ SUBROUTINE DWM_DestroyWake_Deficit_Data( Wake_Deficit_DataData, ErrStat, ErrMsg, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(Wake_Deficit_DataData%Turb_Stress_DWM)) THEN DEALLOCATE(Wake_Deficit_DataData%Turb_Stress_DWM) ENDIF @@ -1094,14 +1062,12 @@ SUBROUTINE DWM_CopyMeanderData( SrcMeanderDataData, DstMeanderDataData, CtrlCode DstMeanderDataData%moving_time = SrcMeanderDataData%moving_time END SUBROUTINE DWM_CopyMeanderData - SUBROUTINE DWM_DestroyMeanderData( MeanderDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_DestroyMeanderData( MeanderDataData, ErrStat, ErrMsg ) TYPE(MeanderData), INTENT(INOUT) :: MeanderDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyMeanderData' @@ -1109,12 +1075,6 @@ SUBROUTINE DWM_DestroyMeanderData( MeanderDataData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE DWM_DestroyMeanderData SUBROUTINE DWM_PackMeanderData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1437,14 +1397,12 @@ SUBROUTINE DWM_Copyread_turbine_position_data( Srcread_turbine_position_dataData ENDIF END SUBROUTINE DWM_Copyread_turbine_position_data - SUBROUTINE DWM_Destroyread_turbine_position_data( read_turbine_position_dataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_Destroyread_turbine_position_data( read_turbine_position_dataData, ErrStat, ErrMsg ) TYPE(read_turbine_position_data), INTENT(INOUT) :: read_turbine_position_dataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroyread_turbine_position_data' @@ -1452,12 +1410,6 @@ SUBROUTINE DWM_Destroyread_turbine_position_data( read_turbine_position_dataData ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(read_turbine_position_dataData%Turbine_sort_order)) THEN DEALLOCATE(read_turbine_position_dataData%Turbine_sort_order) ENDIF @@ -2280,14 +2232,12 @@ SUBROUTINE DWM_CopyWeiMethod( SrcWeiMethodData, DstWeiMethodData, CtrlCode, ErrS DstWeiMethodData%weighting_denominator = SrcWeiMethodData%weighting_denominator END SUBROUTINE DWM_CopyWeiMethod - SUBROUTINE DWM_DestroyWeiMethod( WeiMethodData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_DestroyWeiMethod( WeiMethodData, ErrStat, ErrMsg ) TYPE(WeiMethod), INTENT(INOUT) :: WeiMethodData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyWeiMethod' @@ -2295,12 +2245,6 @@ SUBROUTINE DWM_DestroyWeiMethod( WeiMethodData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(WeiMethodData%sweptarea)) THEN DEALLOCATE(WeiMethodData%sweptarea) ENDIF @@ -2503,14 +2447,12 @@ SUBROUTINE DWM_CopyTIDownstream( SrcTIDownstreamData, DstTIDownstreamData, CtrlC DstTIDownstreamData%temp3 = SrcTIDownstreamData%temp3 END SUBROUTINE DWM_CopyTIDownstream - SUBROUTINE DWM_DestroyTIDownstream( TIDownstreamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_DestroyTIDownstream( TIDownstreamData, ErrStat, ErrMsg ) TYPE(TIDownstream), INTENT(INOUT) :: TIDownstreamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyTIDownstream' @@ -2518,12 +2460,6 @@ SUBROUTINE DWM_DestroyTIDownstream( TIDownstreamData, ErrStat, ErrMsg, DEALLOCAT ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(TIDownstreamData%TI_downstream_matrix)) THEN DEALLOCATE(TIDownstreamData%TI_downstream_matrix) ENDIF @@ -2839,14 +2775,12 @@ SUBROUTINE DWM_CopyTurbKaimal( SrcTurbKaimalData, DstTurbKaimalData, CtrlCode, E DstTurbKaimalData%STD = SrcTurbKaimalData%STD END SUBROUTINE DWM_CopyTurbKaimal - SUBROUTINE DWM_DestroyTurbKaimal( TurbKaimalData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_DestroyTurbKaimal( TurbKaimalData, ErrStat, ErrMsg ) TYPE(TurbKaimal), INTENT(INOUT) :: TurbKaimalData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyTurbKaimal' @@ -2854,12 +2788,6 @@ SUBROUTINE DWM_DestroyTurbKaimal( TurbKaimalData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE DWM_DestroyTurbKaimal SUBROUTINE DWM_PackTurbKaimal( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -3074,14 +3002,12 @@ SUBROUTINE DWM_CopyShinozuka( SrcShinozukaData, DstShinozukaData, CtrlCode, ErrS DstShinozukaData%df = SrcShinozukaData%df END SUBROUTINE DWM_CopyShinozuka - SUBROUTINE DWM_DestroyShinozuka( ShinozukaData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_DestroyShinozuka( ShinozukaData, ErrStat, ErrMsg ) TYPE(Shinozuka), INTENT(INOUT) :: ShinozukaData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyShinozuka' @@ -3089,12 +3015,6 @@ SUBROUTINE DWM_DestroyShinozuka( ShinozukaData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ShinozukaData%f_syn)) THEN DEALLOCATE(ShinozukaData%f_syn) ENDIF @@ -3452,14 +3372,12 @@ SUBROUTINE DWM_Copysmooth_out_wake_data( Srcsmooth_out_wake_dataData, Dstsmooth_ Dstsmooth_out_wake_dataData%length_velocity_array = Srcsmooth_out_wake_dataData%length_velocity_array END SUBROUTINE DWM_Copysmooth_out_wake_data - SUBROUTINE DWM_Destroysmooth_out_wake_data( smooth_out_wake_dataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_Destroysmooth_out_wake_data( smooth_out_wake_dataData, ErrStat, ErrMsg ) TYPE(smooth_out_wake_data), INTENT(INOUT) :: smooth_out_wake_dataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroysmooth_out_wake_data' @@ -3467,12 +3385,6 @@ SUBROUTINE DWM_Destroysmooth_out_wake_data( smooth_out_wake_dataData, ErrStat, E ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE DWM_Destroysmooth_out_wake_data SUBROUTINE DWM_Packsmooth_out_wake_data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -3594,14 +3506,12 @@ SUBROUTINE DWM_CopySWSV( SrcSWSVData, DstSWSVData, CtrlCode, ErrStat, ErrMsg ) DstSWSVData%unit = SrcSWSVData%unit END SUBROUTINE DWM_CopySWSV - SUBROUTINE DWM_DestroySWSV( SWSVData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_DestroySWSV( SWSVData, ErrStat, ErrMsg ) TYPE(SWSV), INTENT(INOUT) :: SWSVData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroySWSV' @@ -3609,12 +3519,6 @@ SUBROUTINE DWM_DestroySWSV( SWSVData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE DWM_DestroySWSV SUBROUTINE DWM_PackSWSV( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -3907,14 +3811,12 @@ SUBROUTINE DWM_Copyread_upwind_result( Srcread_upwind_resultData, Dstread_upwind ENDIF END SUBROUTINE DWM_Copyread_upwind_result - SUBROUTINE DWM_Destroyread_upwind_result( read_upwind_resultData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_Destroyread_upwind_result( read_upwind_resultData, ErrStat, ErrMsg ) TYPE(read_upwind_result), INTENT(INOUT) :: read_upwind_resultData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroyread_upwind_result' @@ -3922,12 +3824,6 @@ SUBROUTINE DWM_Destroyread_upwind_result( read_upwind_resultData, ErrStat, ErrMs ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(read_upwind_resultData%upwind_U)) THEN DEALLOCATE(read_upwind_resultData%upwind_U) ENDIF @@ -4586,14 +4482,12 @@ SUBROUTINE DWM_Copywake_meandered_center( Srcwake_meandered_centerData, Dstwake_ ENDIF END SUBROUTINE DWM_Copywake_meandered_center - SUBROUTINE DWM_Destroywake_meandered_center( wake_meandered_centerData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_Destroywake_meandered_center( wake_meandered_centerData, ErrStat, ErrMsg ) TYPE(wake_meandered_center), INTENT(INOUT) :: wake_meandered_centerData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroywake_meandered_center' @@ -4601,12 +4495,6 @@ SUBROUTINE DWM_Destroywake_meandered_center( wake_meandered_centerData, ErrStat, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(wake_meandered_centerData%wake_width)) THEN DEALLOCATE(wake_meandered_centerData%wake_width) ENDIF @@ -4762,14 +4650,12 @@ SUBROUTINE DWM_Copyturbine_blade( Srcturbine_bladeData, Dstturbine_bladeData, Ct Dstturbine_bladeData%Element_index = Srcturbine_bladeData%Element_index END SUBROUTINE DWM_Copyturbine_blade - SUBROUTINE DWM_Destroyturbine_blade( turbine_bladeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_Destroyturbine_blade( turbine_bladeData, ErrStat, ErrMsg ) TYPE(DWM_turbine_blade), INTENT(INOUT) :: turbine_bladeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroyturbine_blade' @@ -4777,12 +4663,6 @@ SUBROUTINE DWM_Destroyturbine_blade( turbine_bladeData, ErrStat, ErrMsg, DEALLOC ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE DWM_Destroyturbine_blade SUBROUTINE DWM_Packturbine_blade( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -4990,14 +4870,12 @@ SUBROUTINE DWM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyParam - SUBROUTINE DWM_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(DWM_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyParam' @@ -5005,12 +4883,6 @@ SUBROUTINE DWM_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%velocityU)) THEN DEALLOCATE(ParamData%velocityU) ENDIF @@ -5023,9 +4895,9 @@ SUBROUTINE DWM_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(ParamData%ElementRad)) THEN DEALLOCATE(ParamData%ElementRad) ENDIF - CALL DWM_Destroyread_turbine_position_data( ParamData%RTPD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_Destroyread_turbine_position_data( ParamData%RTPD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyParam( ParamData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyParam( ParamData%IfW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyParam @@ -5591,14 +5463,12 @@ SUBROUTINE DWM_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyOtherState - SUBROUTINE DWM_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(DWM_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyOtherState' @@ -5606,13 +5476,7 @@ SUBROUTINE DWM_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL InflowWind_DestroyOtherState( OtherStateData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyOtherState( OtherStateData%IfW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyOtherState @@ -5888,14 +5752,12 @@ SUBROUTINE DWM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyMisc - SUBROUTINE DWM_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(DWM_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyMisc' @@ -5903,13 +5765,7 @@ SUBROUTINE DWM_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL InflowWind_DestroyMisc( MiscData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyMisc( MiscData%IfW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MiscData%Nforce)) THEN DEALLOCATE(MiscData%Nforce) @@ -5917,29 +5773,29 @@ SUBROUTINE DWM_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(MiscData%blade_dr)) THEN DEALLOCATE(MiscData%blade_dr) ENDIF - CALL DWM_Destroyturbine_average_velocity_data( MiscData%TAVD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_Destroyturbine_average_velocity_data( MiscData%TAVD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroycvsd( MiscData%CalVelScale_data, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_DestroyCVSD( MiscData%CalVelScale_data, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroymeanderdata( MiscData%meandering_data, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_DestroyMeanderData( MiscData%meandering_data, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroyweimethod( MiscData%weighting_method, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_DestroyWeiMethod( MiscData%weighting_method, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroytidownstream( MiscData%TI_downstream_data, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_DestroyTIDownstream( MiscData%TI_downstream_data, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroyturbkaimal( MiscData%Turbulence_KS, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_DestroyTurbKaimal( MiscData%Turbulence_KS, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroyshinozuka( MiscData%shinozuka_data, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_DestroyShinozuka( MiscData%shinozuka_data, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroysmooth_out_wake_data( MiscData%SmoothOut, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_Destroysmooth_out_wake_data( MiscData%SmoothOut, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroyswsv( MiscData%smooth_wake_shifted_velocity_data, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_DestroySWSV( MiscData%smooth_wake_shifted_velocity_data, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroywake_deficit_data( MiscData%DWDD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_DestroyWake_Deficit_Data( MiscData%DWDD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroyturbine_blade( MiscData%DWM_tb, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_Destroyturbine_blade( MiscData%DWM_tb, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroywake_meandered_center( MiscData%WMC, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_Destroywake_meandered_center( MiscData%WMC, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyMisc @@ -6032,7 +5888,7 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! CalVelScale_data: size of buffers for each call to pack subtype - CALL DWM_Packcvsd( Re_Buf, Db_Buf, Int_Buf, InData%CalVelScale_data, ErrStat2, ErrMsg2, .TRUE. ) ! CalVelScale_data + CALL DWM_PackCVSD( Re_Buf, Db_Buf, Int_Buf, InData%CalVelScale_data, ErrStat2, ErrMsg2, .TRUE. ) ! CalVelScale_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6049,7 +5905,7 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! meandering_data: size of buffers for each call to pack subtype - CALL DWM_Packmeanderdata( Re_Buf, Db_Buf, Int_Buf, InData%meandering_data, ErrStat2, ErrMsg2, .TRUE. ) ! meandering_data + CALL DWM_PackMeanderData( Re_Buf, Db_Buf, Int_Buf, InData%meandering_data, ErrStat2, ErrMsg2, .TRUE. ) ! meandering_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6066,7 +5922,7 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! weighting_method: size of buffers for each call to pack subtype - CALL DWM_Packweimethod( Re_Buf, Db_Buf, Int_Buf, InData%weighting_method, ErrStat2, ErrMsg2, .TRUE. ) ! weighting_method + CALL DWM_PackWeiMethod( Re_Buf, Db_Buf, Int_Buf, InData%weighting_method, ErrStat2, ErrMsg2, .TRUE. ) ! weighting_method CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6083,7 +5939,7 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! TI_downstream_data: size of buffers for each call to pack subtype - CALL DWM_Packtidownstream( Re_Buf, Db_Buf, Int_Buf, InData%TI_downstream_data, ErrStat2, ErrMsg2, .TRUE. ) ! TI_downstream_data + CALL DWM_PackTIDownstream( Re_Buf, Db_Buf, Int_Buf, InData%TI_downstream_data, ErrStat2, ErrMsg2, .TRUE. ) ! TI_downstream_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6100,7 +5956,7 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Turbulence_KS: size of buffers for each call to pack subtype - CALL DWM_Packturbkaimal( Re_Buf, Db_Buf, Int_Buf, InData%Turbulence_KS, ErrStat2, ErrMsg2, .TRUE. ) ! Turbulence_KS + CALL DWM_PackTurbKaimal( Re_Buf, Db_Buf, Int_Buf, InData%Turbulence_KS, ErrStat2, ErrMsg2, .TRUE. ) ! Turbulence_KS CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6117,7 +5973,7 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! shinozuka_data: size of buffers for each call to pack subtype - CALL DWM_Packshinozuka( Re_Buf, Db_Buf, Int_Buf, InData%shinozuka_data, ErrStat2, ErrMsg2, .TRUE. ) ! shinozuka_data + CALL DWM_PackShinozuka( Re_Buf, Db_Buf, Int_Buf, InData%shinozuka_data, ErrStat2, ErrMsg2, .TRUE. ) ! shinozuka_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6151,7 +6007,7 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! smooth_wake_shifted_velocity_data: size of buffers for each call to pack subtype - CALL DWM_Packswsv( Re_Buf, Db_Buf, Int_Buf, InData%smooth_wake_shifted_velocity_data, ErrStat2, ErrMsg2, .TRUE. ) ! smooth_wake_shifted_velocity_data + CALL DWM_PackSWSV( Re_Buf, Db_Buf, Int_Buf, InData%smooth_wake_shifted_velocity_data, ErrStat2, ErrMsg2, .TRUE. ) ! smooth_wake_shifted_velocity_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6168,7 +6024,7 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! DWDD: size of buffers for each call to pack subtype - CALL DWM_Packwake_deficit_data( Re_Buf, Db_Buf, Int_Buf, InData%DWDD, ErrStat2, ErrMsg2, .TRUE. ) ! DWDD + CALL DWM_PackWake_Deficit_Data( Re_Buf, Db_Buf, Int_Buf, InData%DWDD, ErrStat2, ErrMsg2, .TRUE. ) ! DWDD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6355,7 +6211,7 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL DWM_Packcvsd( Re_Buf, Db_Buf, Int_Buf, InData%CalVelScale_data, ErrStat2, ErrMsg2, OnlySize ) ! CalVelScale_data + CALL DWM_PackCVSD( Re_Buf, Db_Buf, Int_Buf, InData%CalVelScale_data, ErrStat2, ErrMsg2, OnlySize ) ! CalVelScale_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6383,7 +6239,7 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL DWM_Packmeanderdata( Re_Buf, Db_Buf, Int_Buf, InData%meandering_data, ErrStat2, ErrMsg2, OnlySize ) ! meandering_data + CALL DWM_PackMeanderData( Re_Buf, Db_Buf, Int_Buf, InData%meandering_data, ErrStat2, ErrMsg2, OnlySize ) ! meandering_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6411,7 +6267,7 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL DWM_Packweimethod( Re_Buf, Db_Buf, Int_Buf, InData%weighting_method, ErrStat2, ErrMsg2, OnlySize ) ! weighting_method + CALL DWM_PackWeiMethod( Re_Buf, Db_Buf, Int_Buf, InData%weighting_method, ErrStat2, ErrMsg2, OnlySize ) ! weighting_method CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6439,7 +6295,7 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL DWM_Packtidownstream( Re_Buf, Db_Buf, Int_Buf, InData%TI_downstream_data, ErrStat2, ErrMsg2, OnlySize ) ! TI_downstream_data + CALL DWM_PackTIDownstream( Re_Buf, Db_Buf, Int_Buf, InData%TI_downstream_data, ErrStat2, ErrMsg2, OnlySize ) ! TI_downstream_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6467,7 +6323,7 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL DWM_Packturbkaimal( Re_Buf, Db_Buf, Int_Buf, InData%Turbulence_KS, ErrStat2, ErrMsg2, OnlySize ) ! Turbulence_KS + CALL DWM_PackTurbKaimal( Re_Buf, Db_Buf, Int_Buf, InData%Turbulence_KS, ErrStat2, ErrMsg2, OnlySize ) ! Turbulence_KS CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6495,7 +6351,7 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL DWM_Packshinozuka( Re_Buf, Db_Buf, Int_Buf, InData%shinozuka_data, ErrStat2, ErrMsg2, OnlySize ) ! shinozuka_data + CALL DWM_PackShinozuka( Re_Buf, Db_Buf, Int_Buf, InData%shinozuka_data, ErrStat2, ErrMsg2, OnlySize ) ! shinozuka_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6551,7 +6407,7 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL DWM_Packswsv( Re_Buf, Db_Buf, Int_Buf, InData%smooth_wake_shifted_velocity_data, ErrStat2, ErrMsg2, OnlySize ) ! smooth_wake_shifted_velocity_data + CALL DWM_PackSWSV( Re_Buf, Db_Buf, Int_Buf, InData%smooth_wake_shifted_velocity_data, ErrStat2, ErrMsg2, OnlySize ) ! smooth_wake_shifted_velocity_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6579,7 +6435,7 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL DWM_Packwake_deficit_data( Re_Buf, Db_Buf, Int_Buf, InData%DWDD, ErrStat2, ErrMsg2, OnlySize ) ! DWDD + CALL DWM_PackWake_Deficit_Data( Re_Buf, Db_Buf, Int_Buf, InData%DWDD, ErrStat2, ErrMsg2, OnlySize ) ! DWDD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6869,7 +6725,7 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL DWM_Unpackcvsd( Re_Buf, Db_Buf, Int_Buf, OutData%CalVelScale_data, ErrStat2, ErrMsg2 ) ! CalVelScale_data + CALL DWM_UnpackCVSD( Re_Buf, Db_Buf, Int_Buf, OutData%CalVelScale_data, ErrStat2, ErrMsg2 ) ! CalVelScale_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6909,7 +6765,7 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL DWM_Unpackmeanderdata( Re_Buf, Db_Buf, Int_Buf, OutData%meandering_data, ErrStat2, ErrMsg2 ) ! meandering_data + CALL DWM_UnpackMeanderData( Re_Buf, Db_Buf, Int_Buf, OutData%meandering_data, ErrStat2, ErrMsg2 ) ! meandering_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6949,7 +6805,7 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL DWM_Unpackweimethod( Re_Buf, Db_Buf, Int_Buf, OutData%weighting_method, ErrStat2, ErrMsg2 ) ! weighting_method + CALL DWM_UnpackWeiMethod( Re_Buf, Db_Buf, Int_Buf, OutData%weighting_method, ErrStat2, ErrMsg2 ) ! weighting_method CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6989,7 +6845,7 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL DWM_Unpacktidownstream( Re_Buf, Db_Buf, Int_Buf, OutData%TI_downstream_data, ErrStat2, ErrMsg2 ) ! TI_downstream_data + CALL DWM_UnpackTIDownstream( Re_Buf, Db_Buf, Int_Buf, OutData%TI_downstream_data, ErrStat2, ErrMsg2 ) ! TI_downstream_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7029,7 +6885,7 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL DWM_Unpackturbkaimal( Re_Buf, Db_Buf, Int_Buf, OutData%Turbulence_KS, ErrStat2, ErrMsg2 ) ! Turbulence_KS + CALL DWM_UnpackTurbKaimal( Re_Buf, Db_Buf, Int_Buf, OutData%Turbulence_KS, ErrStat2, ErrMsg2 ) ! Turbulence_KS CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7069,7 +6925,7 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL DWM_Unpackshinozuka( Re_Buf, Db_Buf, Int_Buf, OutData%shinozuka_data, ErrStat2, ErrMsg2 ) ! shinozuka_data + CALL DWM_UnpackShinozuka( Re_Buf, Db_Buf, Int_Buf, OutData%shinozuka_data, ErrStat2, ErrMsg2 ) ! shinozuka_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7149,7 +7005,7 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL DWM_Unpackswsv( Re_Buf, Db_Buf, Int_Buf, OutData%smooth_wake_shifted_velocity_data, ErrStat2, ErrMsg2 ) ! smooth_wake_shifted_velocity_data + CALL DWM_UnpackSWSV( Re_Buf, Db_Buf, Int_Buf, OutData%smooth_wake_shifted_velocity_data, ErrStat2, ErrMsg2 ) ! smooth_wake_shifted_velocity_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7189,7 +7045,7 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL DWM_Unpackwake_deficit_data( Re_Buf, Db_Buf, Int_Buf, OutData%DWDD, ErrStat2, ErrMsg2 ) ! DWDD + CALL DWM_UnpackWake_Deficit_Data( Re_Buf, Db_Buf, Int_Buf, OutData%DWDD, ErrStat2, ErrMsg2 ) ! DWDD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7306,14 +7162,12 @@ SUBROUTINE DWM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyInput - SUBROUTINE DWM_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(DWM_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyInput' @@ -7321,15 +7175,9 @@ SUBROUTINE DWM_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL DWM_Destroyread_upwind_result( InputData%Upwind_result, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL DWM_Destroyread_upwind_result( InputData%Upwind_result, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( InputData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyInput( InputData%IfW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyInput @@ -7730,14 +7578,12 @@ SUBROUTINE DWM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyOutput - SUBROUTINE DWM_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(DWM_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyOutput' @@ -7745,12 +7591,6 @@ SUBROUTINE DWM_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%turbine_thrust_force)) THEN DEALLOCATE(OutputData%turbine_thrust_force) ENDIF @@ -7775,7 +7615,7 @@ SUBROUTINE DWM_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(OutputData%smoothed_velocity_array)) THEN DEALLOCATE(OutputData%smoothed_velocity_array) ENDIF - CALL InflowWind_DestroyOutput( OutputData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyOutput( OutputData%IfW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyOutput @@ -8364,14 +8204,12 @@ SUBROUTINE DWM_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrS IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyContState - SUBROUTINE DWM_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(DWM_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyContState' @@ -8379,13 +8217,7 @@ SUBROUTINE DWM_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL InflowWind_DestroyContState( ContStateData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyContState( ContStateData%IfW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyContState @@ -8592,14 +8424,12 @@ SUBROUTINE DWM_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyDiscState - SUBROUTINE DWM_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(DWM_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyDiscState' @@ -8607,13 +8437,7 @@ SUBROUTINE DWM_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL InflowWind_DestroyDiscState( DiscStateData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyDiscState( DiscStateData%IfW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyDiscState @@ -8820,14 +8644,12 @@ SUBROUTINE DWM_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyConstrState - SUBROUTINE DWM_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(DWM_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyConstrState' @@ -8835,13 +8657,7 @@ SUBROUTINE DWM_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL InflowWind_DestroyConstrState( ConstrStateData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyConstrState( ConstrStateData%IfW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyConstrState @@ -9048,14 +8864,12 @@ SUBROUTINE DWM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrS IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyInitInput - SUBROUTINE DWM_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(DWM_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyInitInput' @@ -9063,13 +8877,7 @@ SUBROUTINE DWM_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL InflowWind_DestroyInitInput( InitInputData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyInitInput( InitInputData%IfW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyInitInput @@ -9276,14 +9084,12 @@ SUBROUTINE DWM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, E IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE DWM_CopyInitOutput - SUBROUTINE DWM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE DWM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(DWM_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyInitOutput' @@ -9291,13 +9097,7 @@ SUBROUTINE DWM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL InflowWind_DestroyInitOutput( InitOutputData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyInitOutput( InitOutputData%IfW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyInitOutput diff --git a/modules/aerodyn14/src/Registry-AD14.txt b/modules/aerodyn14/src/Registry-AD14.txt index 59eceb2c7b..8a4e36b04c 100644 --- a/modules/aerodyn14/src/Registry-AD14.txt +++ b/modules/aerodyn14/src/Registry-AD14.txt @@ -132,18 +132,15 @@ typedef ^ BladeParms ReKi BladeLength - - - "Blade Length" #typedef ^ BladeParms INTEGER NB - - - "Number odem blades" #DynInflow -dimspec maxinfl constant=6 -dimspec maxinfl0 constant=2 -dimspec maxinfl1 constant=3:6 -typedef AeroDyn14/AD14 DynInflow ReKi dAlph_dt {maxinfl}{4} - - -typedef ^ DynInflow ReKi dBeta_dt {maxinfl1}{4} - - +typedef AeroDyn14/AD14 DynInflow ReKi dAlph_dt {6}{4} - - +typedef ^ DynInflow ReKi dBeta_dt {3:6}{4} - - typedef ^ DynInflow ReKi DTO - - - -typedef ^ DynInflow ReKi old_Alph {maxinfl} - - -typedef ^ DynInflow ReKi old_Beta {maxinfl1} - - +typedef ^ DynInflow ReKi old_Alph {6} - - +typedef ^ DynInflow ReKi old_Beta {3:6} - - typedef ^ DynInflow ReKi old_LmdM - - - typedef ^ DynInflow ReKi oldKai - - - -typedef ^ DynInflow ReKi PhiLqC {maxinfl} - - -typedef ^ DynInflow ReKi PhiLqS {maxinfl1} - - +typedef ^ DynInflow ReKi PhiLqC {6} - - +typedef ^ DynInflow ReKi PhiLqS {3:6} - - typedef ^ DynInflow ReKi Pzero - - - typedef ^ DynInflow ReKi RMC_SAVE {:}{:}{:} - - - typedef ^ DynInflow ReKi RMS_SAVE {:}{:}{:} - - - @@ -151,21 +148,21 @@ typedef ^ DynInflow ReKi TipSpeed - - - typedef ^ DynInflow ReKi totalInf - - - typedef ^ DynInflow ReKi Vparam - - - typedef ^ DynInflow ReKi Vtotal - - - -typedef ^ DynInflow ReKi xAlpha {maxinfl} - - -typedef ^ DynInflow ReKi xBeta {maxinfl1} - - +typedef ^ DynInflow ReKi xAlpha {6} - - +typedef ^ DynInflow ReKi xBeta {3:6} - - typedef ^ DynInflow ReKi xKai - - - typedef ^ DynInflow ReKi XLAMBDA_M - - - -typedef ^ DynInflow ReKi xLcos {maxinfl}{maxinfl} - - -typedef ^ DynInflow ReKi xLsin {maxinfl1}{maxinfl1} - - -typedef ^ DynInflow IntKi MminR {maxinfl}{maxinfl} - - -typedef ^ DynInflow IntKi MminusR {maxinfl}{maxinfl} - - -typedef ^ DynInflow IntKi MplusR {maxinfl}{maxinfl} - - -typedef ^ DynInflow ReKi GAMMA {maxinfl}{maxinfl} - - +typedef ^ DynInflow ReKi xLcos {6}{6} - - +typedef ^ DynInflow ReKi xLsin {3:6}{3:6} - - +typedef ^ DynInflow IntKi MminR {6}{6} - - +typedef ^ DynInflow IntKi MminusR {6}{6} - - +typedef ^ DynInflow IntKi MplusR {6}{6} - - +typedef ^ DynInflow ReKi GAMMA {6}{6} - - #typedef ^ DynInflowParms IntKi MAXINFL - 6 - #should be possible to spec with maxinfl typedef ^ DynInflowParms IntKi MAXINFLO - 2 - #should be possible to spec with maxinfl0 -#typedef ^ DynInflowParms IntKi MRvector {maxinfl} - - -#typedef ^ DynInflowParms IntKi NJvector {maxinfl} - - -typedef ^ DynInflowParms ReKi xMinv {maxinfl} - - +#typedef ^ DynInflowParms IntKi MRvector {6} - - +#typedef ^ DynInflowParms IntKi NJvector {6} - - +typedef ^ DynInflowParms ReKi xMinv {6} - - #Element typedef ^ Element ReKi A {:}{:} - - - "Axial induction factor" - diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index c183223332..541f8e297c 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -281,14 +281,12 @@ SUBROUTINE AWAE_CopyHighWindGrid( SrcHighWindGridData, DstHighWindGridData, Ctrl ENDIF END SUBROUTINE AWAE_CopyHighWindGrid - SUBROUTINE AWAE_DestroyHighWindGrid( HighWindGridData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AWAE_DestroyHighWindGrid( HighWindGridData, ErrStat, ErrMsg ) TYPE(AWAE_HighWindGrid), INTENT(INOUT) :: HighWindGridData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyHighWindGrid' @@ -296,12 +294,6 @@ SUBROUTINE AWAE_DestroyHighWindGrid( HighWindGridData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(HighWindGridData%data)) THEN DEALLOCATE(HighWindGridData%data) ENDIF @@ -652,14 +644,12 @@ SUBROUTINE AWAE_CopyInputFileType( SrcInputFileTypeData, DstInputFileTypeData, C DstInputFileTypeData%Mod_Projection = SrcInputFileTypeData%Mod_Projection END SUBROUTINE AWAE_CopyInputFileType - SUBROUTINE AWAE_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AWAE_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg ) TYPE(AWAE_InputFileType), INTENT(INOUT) :: InputFileTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyInputFileType' @@ -667,12 +657,6 @@ SUBROUTINE AWAE_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputFileTypeData%OutDisWindZ)) THEN DEALLOCATE(InputFileTypeData%OutDisWindZ) ENDIF @@ -1369,14 +1353,12 @@ SUBROUTINE AWAE_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%OutFileRoot = SrcInitInputData%OutFileRoot END SUBROUTINE AWAE_CopyInitInput - SUBROUTINE AWAE_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AWAE_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(AWAE_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyInitInput' @@ -1384,13 +1366,7 @@ SUBROUTINE AWAE_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL AWAE_Destroyinputfiletype( InitInputData%InputFileData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AWAE_DestroyInputFileType( InitInputData%InputFileData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AWAE_DestroyInitInput @@ -1431,7 +1407,7 @@ SUBROUTINE AWAE_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! InputFileData: size of buffers for each call to pack subtype - CALL AWAE_Packinputfiletype( Re_Buf, Db_Buf, Int_Buf, InData%InputFileData, ErrStat2, ErrMsg2, .TRUE. ) ! InputFileData + CALL AWAE_PackInputFileType( Re_Buf, Db_Buf, Int_Buf, InData%InputFileData, ErrStat2, ErrMsg2, .TRUE. ) ! InputFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1477,7 +1453,7 @@ SUBROUTINE AWAE_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - CALL AWAE_Packinputfiletype( Re_Buf, Db_Buf, Int_Buf, InData%InputFileData, ErrStat2, ErrMsg2, OnlySize ) ! InputFileData + CALL AWAE_PackInputFileType( Re_Buf, Db_Buf, Int_Buf, InData%InputFileData, ErrStat2, ErrMsg2, OnlySize ) ! InputFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1574,7 +1550,7 @@ SUBROUTINE AWAE_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AWAE_Unpackinputfiletype( Re_Buf, Db_Buf, Int_Buf, OutData%InputFileData, ErrStat2, ErrMsg2 ) ! InputFileData + CALL AWAE_UnpackInputFileType( Re_Buf, Db_Buf, Int_Buf, OutData%InputFileData, ErrStat2, ErrMsg2 ) ! InputFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1695,14 +1671,12 @@ SUBROUTINE AWAE_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%Z0_low = SrcInitOutputData%Z0_low END SUBROUTINE AWAE_CopyInitOutput - SUBROUTINE AWAE_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AWAE_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(AWAE_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyInitOutput' @@ -1710,13 +1684,7 @@ SUBROUTINE AWAE_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitOutputData%X0_high)) THEN DEALLOCATE(InitOutputData%X0_high) @@ -1775,7 +1743,7 @@ SUBROUTINE AWAE_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1860,7 +1828,7 @@ SUBROUTINE AWAE_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2064,7 +2032,7 @@ SUBROUTINE AWAE_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2238,14 +2206,12 @@ SUBROUTINE AWAE_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Err ENDIF END SUBROUTINE AWAE_CopyContState - SUBROUTINE AWAE_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AWAE_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(AWAE_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyContState' @@ -2253,15 +2219,9 @@ SUBROUTINE AWAE_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ContStateData%IfW)) THEN DO i1 = LBOUND(ContStateData%IfW,1), UBOUND(ContStateData%IfW,1) - CALL InflowWind_DestroyContState( ContStateData%IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyContState( ContStateData%IfW(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ContStateData%IfW) @@ -2515,14 +2475,12 @@ SUBROUTINE AWAE_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Err ENDIF END SUBROUTINE AWAE_CopyDiscState - SUBROUTINE AWAE_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AWAE_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(AWAE_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyDiscState' @@ -2530,15 +2488,9 @@ SUBROUTINE AWAE_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(DiscStateData%IfW)) THEN DO i1 = LBOUND(DiscStateData%IfW,1), UBOUND(DiscStateData%IfW,1) - CALL InflowWind_DestroyDiscState( DiscStateData%IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyDiscState( DiscStateData%IfW(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(DiscStateData%IfW) @@ -2792,14 +2744,12 @@ SUBROUTINE AWAE_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCod ENDIF END SUBROUTINE AWAE_CopyConstrState - SUBROUTINE AWAE_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AWAE_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(AWAE_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyConstrState' @@ -2807,15 +2757,9 @@ SUBROUTINE AWAE_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ConstrStateData%IfW)) THEN DO i1 = LBOUND(ConstrStateData%IfW,1), UBOUND(ConstrStateData%IfW,1) - CALL InflowWind_DestroyConstrState( ConstrStateData%IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyConstrState( ConstrStateData%IfW(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ConstrStateData%IfW) @@ -3069,14 +3013,12 @@ SUBROUTINE AWAE_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ENDIF END SUBROUTINE AWAE_CopyOtherState - SUBROUTINE AWAE_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AWAE_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(AWAE_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyOtherState' @@ -3084,15 +3026,9 @@ SUBROUTINE AWAE_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OtherStateData%IfW)) THEN DO i1 = LBOUND(OtherStateData%IfW,1), UBOUND(OtherStateData%IfW,1) - CALL InflowWind_DestroyOtherState( OtherStateData%IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyOtherState( OtherStateData%IfW(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OtherStateData%IfW) @@ -3605,14 +3541,12 @@ SUBROUTINE AWAE_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE AWAE_CopyMisc - SUBROUTINE AWAE_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AWAE_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(AWAE_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyMisc' @@ -3620,12 +3554,6 @@ SUBROUTINE AWAE_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MiscData%Vamb_low)) THEN DEALLOCATE(MiscData%Vamb_low) ENDIF @@ -3640,7 +3568,7 @@ SUBROUTINE AWAE_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(MiscData%Vamb_High)) THEN DO i1 = LBOUND(MiscData%Vamb_High,1), UBOUND(MiscData%Vamb_High,1) - CALL AWAE_Destroyhighwindgrid( MiscData%Vamb_High(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AWAE_DestroyHighWindGrid( MiscData%Vamb_High(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%Vamb_High) @@ -3677,18 +3605,18 @@ SUBROUTINE AWAE_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(MiscData%IfW)) THEN DO i1 = LBOUND(MiscData%IfW,1), UBOUND(MiscData%IfW,1) - CALL InflowWind_DestroyMisc( MiscData%IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyMisc( MiscData%IfW(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%IfW) ENDIF - CALL InflowWind_DestroyInput( MiscData%u_IfW_Low, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyInput( MiscData%u_IfW_Low, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( MiscData%u_IfW_High, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyInput( MiscData%u_IfW_High, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( MiscData%y_IfW_Low, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyOutput( MiscData%y_IfW_Low, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( MiscData%y_IfW_High, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyOutput( MiscData%y_IfW_High, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AWAE_DestroyMisc @@ -3753,7 +3681,7 @@ SUBROUTINE AWAE_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%Vamb_High,1), UBOUND(InData%Vamb_High,1) Int_BufSz = Int_BufSz + 3 ! Vamb_High: size of buffers for each call to pack subtype - CALL AWAE_Packhighwindgrid( Re_Buf, Db_Buf, Int_Buf, InData%Vamb_High(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Vamb_High + CALL AWAE_PackHighWindGrid( Re_Buf, Db_Buf, Int_Buf, InData%Vamb_High(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Vamb_High CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4060,7 +3988,7 @@ SUBROUTINE AWAE_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%Vamb_High,1), UBOUND(InData%Vamb_High,1) - CALL AWAE_Packhighwindgrid( Re_Buf, Db_Buf, Int_Buf, InData%Vamb_High(i1), ErrStat2, ErrMsg2, OnlySize ) ! Vamb_High + CALL AWAE_PackHighWindGrid( Re_Buf, Db_Buf, Int_Buf, InData%Vamb_High(i1), ErrStat2, ErrMsg2, OnlySize ) ! Vamb_High CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4694,7 +4622,7 @@ SUBROUTINE AWAE_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AWAE_Unpackhighwindgrid( Re_Buf, Db_Buf, Int_Buf, OutData%Vamb_High(i1), ErrStat2, ErrMsg2 ) ! Vamb_High + CALL AWAE_UnpackHighWindGrid( Re_Buf, Db_Buf, Int_Buf, OutData%Vamb_High(i1), ErrStat2, ErrMsg2 ) ! Vamb_High CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5449,14 +5377,12 @@ SUBROUTINE AWAE_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%VTK_tWidth = SrcParamData%VTK_tWidth END SUBROUTINE AWAE_CopyParam - SUBROUTINE AWAE_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AWAE_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(AWAE_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyParam' @@ -5464,12 +5390,6 @@ SUBROUTINE AWAE_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%y)) THEN DEALLOCATE(ParamData%y) ENDIF @@ -5505,7 +5425,7 @@ SUBROUTINE AWAE_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(ParamData%IfW)) THEN DO i1 = LBOUND(ParamData%IfW,1), UBOUND(ParamData%IfW,1) - CALL InflowWind_DestroyParam( ParamData%IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyParam( ParamData%IfW(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%IfW) @@ -6587,14 +6507,12 @@ SUBROUTINE AWAE_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err ENDIF END SUBROUTINE AWAE_CopyOutput - SUBROUTINE AWAE_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AWAE_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(AWAE_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyOutput' @@ -6602,15 +6520,9 @@ SUBROUTINE AWAE_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%Vdist_High)) THEN DO i1 = LBOUND(OutputData%Vdist_High,1), UBOUND(OutputData%Vdist_High,1) - CALL AWAE_Destroyhighwindgrid( OutputData%Vdist_High(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AWAE_DestroyHighWindGrid( OutputData%Vdist_High(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OutputData%Vdist_High) @@ -6667,7 +6579,7 @@ SUBROUTINE AWAE_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%Vdist_High,1), UBOUND(InData%Vdist_High,1) Int_BufSz = Int_BufSz + 3 ! Vdist_High: size of buffers for each call to pack subtype - CALL AWAE_Packhighwindgrid( Re_Buf, Db_Buf, Int_Buf, InData%Vdist_High(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Vdist_High + CALL AWAE_PackHighWindGrid( Re_Buf, Db_Buf, Int_Buf, InData%Vdist_High(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Vdist_High CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6738,7 +6650,7 @@ SUBROUTINE AWAE_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%Vdist_High,1), UBOUND(InData%Vdist_High,1) - CALL AWAE_Packhighwindgrid( Re_Buf, Db_Buf, Int_Buf, InData%Vdist_High(i1), ErrStat2, ErrMsg2, OnlySize ) ! Vdist_High + CALL AWAE_PackHighWindGrid( Re_Buf, Db_Buf, Int_Buf, InData%Vdist_High(i1), ErrStat2, ErrMsg2, OnlySize ) ! Vdist_High CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6901,7 +6813,7 @@ SUBROUTINE AWAE_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AWAE_Unpackhighwindgrid( Re_Buf, Db_Buf, Int_Buf, OutData%Vdist_High(i1), ErrStat2, ErrMsg2 ) ! Vdist_High + CALL AWAE_UnpackHighWindGrid( Re_Buf, Db_Buf, Int_Buf, OutData%Vdist_High(i1), ErrStat2, ErrMsg2 ) ! Vdist_High CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7112,14 +7024,12 @@ SUBROUTINE AWAE_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE AWAE_CopyInput - SUBROUTINE AWAE_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE AWAE_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(AWAE_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyInput' @@ -7127,12 +7037,6 @@ SUBROUTINE AWAE_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputData%xhat_plane)) THEN DEALLOCATE(InputData%xhat_plane) ENDIF diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 2e38e89c90..acb5b1abaf 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -263,13 +263,13 @@ MODULE BeamDyn_Types REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: vvv !< Translational velocity and rotational parameter velocity (at current QP) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: vvp !< Derivative of vvv with respect to X [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: aaa !< Translational acceleration and rotational parameter acceration (at current QP) [-] - REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: RR0 !< Rotation tensor at current QP \f$ \left(\underline{\underline{R}}\underline{\underline{R}}_0\right) \f$ [-] - REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: kappa !< Curvature vector \f$ \underline{k} \f$ at current QP (note this is not \kappa, but a term in \kappa) [-] - REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: E1 !< \vec{e_1} = x_0^\prime + u^\prime (3) at current QP [-] + REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: RR0 !< Rotation tensor at current QP f$ left(underline{underline{R}}underline{underline{R}}_0right) f$ [-] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: kappa !< Curvature vector f$ underline{k} f$ at current QP (note this is not kappa, but a term in kappa) [-] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: E1 !< vec{e_1} = x_0^prime + u^prime (3) at current QP [-] REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: Stif !< C/S stiffness matrix resolved in inertial frame at current QP. 6x6 [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Fb !< Gyroscopic forces at current QP. 6 [-] - REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Fc !< Elastic force \f$ \underline{F}^c \f$ at current QP. 6 [-] - REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Fd !< Elastic force \f$ \underline{F}^d \f$ at current QP. 6 [-] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Fc !< Elastic force f$ underline{F}^c f$ at current QP. 6 [-] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Fd !< Elastic force f$ underline{F}^d f$ at current QP. 6 [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Fg !< Gravity forces at current QP. 6 [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Fi !< Inertial forces at current QP. 6 [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Ftemp !< Sum of some of the forces at current QP. 6 [-] @@ -279,9 +279,9 @@ MODULE BeamDyn_Types REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: Gi !< Gyroscopic matrix for inertial force. 6x6 [-] REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: Ki !< Stiffness matrix for inertial force. 6x6 [-] REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: Mi !< Mass matrix for inertial force. 6x6 [-] - REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: Oe !< \f$ \underline{\underline{\mathcal{O}}} \f$ from equation (19) of NREL CP-2C00-60759. 6x6 [-] - REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: Pe !< \f$ \underline{\underline{\mathcal{P}}} \f$ from equation (20) of NREL CP-2C00-60759. 6x6 [-] - REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: Qe !< \f$ \underline{\underline{\mathcal{Q}}} \f$ from equation (21) of NREL CP-2C00-60759. 6x6 [-] + REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: Oe !< f$ underline{underline{mathcal{O}}} f$ from equation (19) of NREL CP-2C00-60759. 6x6 [-] + REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: Pe !< f$ underline{underline{mathcal{P}}} f$ from equation (20) of NREL CP-2C00-60759. 6x6 [-] + REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: Qe !< f$ underline{underline{mathcal{Q}}} f$ from equation (21) of NREL CP-2C00-60759. 6x6 [-] REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: Gd !< Dissipative term for gyroscopic term. 6x6 [-] REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: Od !< Dissipative term on O. 6x6 [-] REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: Pd !< Dissipative term on P. 6x6 [-] @@ -344,8 +344,6 @@ SUBROUTINE BD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyInitInput' @@ -366,14 +364,12 @@ SUBROUTINE BD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%DynamicSolve = SrcInitInputData%DynamicSolve END SUBROUTINE BD_CopyInitInput - SUBROUTINE BD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(BD_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyInitInput' @@ -381,12 +377,6 @@ SUBROUTINE BD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE BD_DestroyInitInput SUBROUTINE BD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -530,8 +520,6 @@ SUBROUTINE BD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: i INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackInitInput' @@ -775,14 +763,12 @@ SUBROUTINE BD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er ENDIF END SUBROUTINE BD_CopyInitOutput - SUBROUTINE BD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(BD_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyInitOutput' @@ -790,19 +776,13 @@ SUBROUTINE BD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) ENDIF IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN DEALLOCATE(InitOutputData%WriteOutputUnt) ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitOutputData%kp_coordinate)) THEN DEALLOCATE(InitOutputData%kp_coordinate) @@ -880,7 +860,7 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1003,7 +983,7 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END DO ! I END DO END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1282,7 +1262,7 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1533,14 +1513,12 @@ SUBROUTINE BD_CopyBladeInputData( SrcBladeInputDataData, DstBladeInputDataData, DstBladeInputDataData%damp_flag = SrcBladeInputDataData%damp_flag END SUBROUTINE BD_CopyBladeInputData - SUBROUTINE BD_DestroyBladeInputData( BladeInputDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BD_DestroyBladeInputData( BladeInputDataData, ErrStat, ErrMsg ) TYPE(BladeInputData), INTENT(INOUT) :: BladeInputDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyBladeInputData' @@ -1548,12 +1526,6 @@ SUBROUTINE BD_DestroyBladeInputData( BladeInputDataData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(BladeInputDataData%station_eta)) THEN DEALLOCATE(BladeInputDataData%station_eta) ENDIF @@ -1954,14 +1926,12 @@ SUBROUTINE BD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str END SUBROUTINE BD_CopyInputFile - SUBROUTINE BD_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) TYPE(BD_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyInputFile' @@ -1969,16 +1939,10 @@ SUBROUTINE BD_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputFileData%kp_member)) THEN DEALLOCATE(InputFileData%kp_member) ENDIF - CALL BD_Destroybladeinputdata( InputFileData%InpBl, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyBladeInputData( InputFileData%InpBl, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InputFileData%kp_coordinate)) THEN DEALLOCATE(InputFileData%kp_coordinate) @@ -2046,7 +2010,7 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_BufSz = Db_BufSz + 1 ! DTBeam ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! InpBl: size of buffers for each call to pack subtype - CALL BD_Packbladeinputdata( Re_Buf, Db_Buf, Int_Buf, InData%InpBl, ErrStat2, ErrMsg2, .TRUE. ) ! InpBl + CALL BD_PackBladeInputData( Re_Buf, Db_Buf, Int_Buf, InData%InpBl, ErrStat2, ErrMsg2, .TRUE. ) ! InpBl CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2165,7 +2129,7 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = Db_Xferred + 1 DbKiBuf(Db_Xferred) = InData%DTBeam Db_Xferred = Db_Xferred + 1 - CALL BD_Packbladeinputdata( Re_Buf, Db_Buf, Int_Buf, InData%InpBl, ErrStat2, ErrMsg2, OnlySize ) ! InpBl + CALL BD_PackBladeInputData( Re_Buf, Db_Buf, Int_Buf, InData%InpBl, ErrStat2, ErrMsg2, OnlySize ) ! InpBl CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2413,7 +2377,7 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_Unpackbladeinputdata( Re_Buf, Db_Buf, Int_Buf, OutData%InpBl, ErrStat2, ErrMsg2 ) ! InpBl + CALL BD_UnpackBladeInputData( Re_Buf, Db_Buf, Int_Buf, OutData%InpBl, ErrStat2, ErrMsg2 ) ! InpBl CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2601,14 +2565,12 @@ SUBROUTINE BD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrSt ENDIF END SUBROUTINE BD_CopyContState - SUBROUTINE BD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BD_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(BD_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyContState' @@ -2616,12 +2578,6 @@ SUBROUTINE BD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ContStateData%q)) THEN DEALLOCATE(ContStateData%q) ENDIF @@ -2838,14 +2794,12 @@ SUBROUTINE BD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt DstDiscStateData%thetaPD = SrcDiscStateData%thetaPD END SUBROUTINE BD_CopyDiscState - SUBROUTINE BD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(BD_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyDiscState' @@ -2853,12 +2807,6 @@ SUBROUTINE BD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE BD_DestroyDiscState SUBROUTINE BD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2980,14 +2928,12 @@ SUBROUTINE BD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE BD_CopyConstrState - SUBROUTINE BD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(BD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyConstrState' @@ -2995,12 +2941,6 @@ SUBROUTINE BD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE BD_DestroyConstrState SUBROUTINE BD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -3148,14 +3088,12 @@ SUBROUTINE BD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%RunQuasiStaticInit = SrcOtherStateData%RunQuasiStaticInit END SUBROUTINE BD_CopyOtherState - SUBROUTINE BD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(BD_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyOtherState' @@ -3163,12 +3101,6 @@ SUBROUTINE BD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OtherStateData%acc)) THEN DEALLOCATE(OtherStateData%acc) ENDIF @@ -3426,14 +3358,12 @@ SUBROUTINE BD_CopyqpParam( SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, Er ENDIF END SUBROUTINE BD_CopyqpParam - SUBROUTINE BD_DestroyqpParam( qpParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BD_DestroyqpParam( qpParamData, ErrStat, ErrMsg ) TYPE(qpParam), INTENT(INOUT) :: qpParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyqpParam' @@ -3441,12 +3371,6 @@ SUBROUTINE BD_DestroyqpParam( qpParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(qpParamData%mmm)) THEN DEALLOCATE(qpParamData%mmm) ENDIF @@ -4134,14 +4058,12 @@ SUBROUTINE BD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%RelStates = SrcParamData%RelStates END SUBROUTINE BD_CopyParam - SUBROUTINE BD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BD_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(BD_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyParam' @@ -4149,12 +4071,6 @@ SUBROUTINE BD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%uuN0)) THEN DEALLOCATE(ParamData%uuN0) ENDIF @@ -4199,7 +4115,7 @@ SUBROUTINE BD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) @@ -4213,11 +4129,11 @@ SUBROUTINE BD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(ParamData%OutNd2NdElem)) THEN DEALLOCATE(ParamData%OutNd2NdElem) ENDIF - CALL BD_Destroyqpparam( ParamData%qp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyqpParam( ParamData%qp, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(ParamData%BldNd_OutParam)) THEN DO i1 = LBOUND(ParamData%BldNd_OutParam,1), UBOUND(ParamData%BldNd_OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyOutParmType( ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%BldNd_OutParam) @@ -4392,7 +4308,7 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4434,7 +4350,7 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Re_BufSz = Re_BufSz + 1 ! pitchC Re_BufSz = Re_BufSz + SIZE(InData%torqM) ! torqM Int_BufSz = Int_BufSz + 3 ! qp: size of buffers for each call to pack subtype - CALL BD_Packqpparam( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, .TRUE. ) ! qp + CALL BD_PackqpParam( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, .TRUE. ) ! qp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4463,7 +4379,7 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutParam upper/lower bounds for each dimension DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) Int_BufSz = Int_BufSz + 3 ! BldNd_OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4939,7 +4855,7 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5043,7 +4959,7 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Re_Xferred = Re_Xferred + 1 END DO END DO - CALL BD_Packqpparam( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, OnlySize ) ! qp + CALL BD_PackqpParam( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, OnlySize ) ! qp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5098,7 +5014,7 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5851,7 +5767,7 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5982,7 +5898,7 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_Unpackqpparam( Re_Buf, Db_Buf, Int_Buf, OutData%qp, ErrStat2, ErrMsg2 ) ! qp + CALL BD_UnpackqpParam( Re_Buf, Db_Buf, Int_Buf, OutData%qp, ErrStat2, ErrMsg2 ) ! qp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6052,7 +5968,7 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_OutParam + CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6332,14 +6248,12 @@ SUBROUTINE BD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE BD_CopyInput - SUBROUTINE BD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BD_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(BD_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyInput' @@ -6347,12 +6261,6 @@ SUBROUTINE BD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( InputData%RootMotion, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL MeshDestroy( InputData%PointLoad, ErrStat2, ErrMsg2 ) @@ -6833,14 +6741,12 @@ SUBROUTINE BD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs ENDIF END SUBROUTINE BD_CopyOutput - SUBROUTINE BD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BD_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(BD_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyOutput' @@ -6848,12 +6754,6 @@ SUBROUTINE BD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( OutputData%ReactionForce, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL MeshDestroy( OutputData%BldMotion, ErrStat2, ErrMsg2 ) @@ -7725,14 +7625,12 @@ SUBROUTINE BD_CopyEqMotionQP( SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Er ENDIF END SUBROUTINE BD_CopyEqMotionQP - SUBROUTINE BD_DestroyEqMotionQP( EqMotionQPData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BD_DestroyEqMotionQP( EqMotionQPData, ErrStat, ErrMsg ) TYPE(EqMotionQP), INTENT(INOUT) :: EqMotionQPData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyEqMotionQP' @@ -7740,12 +7638,6 @@ SUBROUTINE BD_DestroyEqMotionQP( EqMotionQPData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(EqMotionQPData%uuu)) THEN DEALLOCATE(EqMotionQPData%uuu) ENDIF @@ -10401,14 +10293,12 @@ SUBROUTINE BD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE BD_CopyMisc - SUBROUTINE BD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE BD_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(BD_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyMisc' @@ -10416,21 +10306,15 @@ SUBROUTINE BD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( MiscData%u_DistrLoad_at_y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL MeshDestroy( MiscData%y_BldMotion_at_u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( MiscData%Map_u_DistrLoad_to_y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( MiscData%Map_u_DistrLoad_to_y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( MiscData%Map_y_BldMotion_to_u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( MiscData%Map_y_BldMotion_to_u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL BD_Destroyeqmotionqp( MiscData%qp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyEqMotionQP( MiscData%qp, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MiscData%lin_A)) THEN DEALLOCATE(MiscData%lin_A) @@ -10522,9 +10406,9 @@ SUBROUTINE BD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(MiscData%LP_indx)) THEN DEALLOCATE(MiscData%LP_indx) ENDIF - CALL BD_DestroyInput( MiscData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyInput( MiscData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL BD_DestroyInput( MiscData%u2, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyInput( MiscData%u2, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE BD_DestroyMisc @@ -10599,7 +10483,7 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Map_u_DistrLoad_to_y: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Map_u_DistrLoad_to_y, ErrStat2, ErrMsg2, .TRUE. ) ! Map_u_DistrLoad_to_y + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Map_u_DistrLoad_to_y, ErrStat2, ErrMsg2, .TRUE. ) ! Map_u_DistrLoad_to_y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10616,7 +10500,7 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Map_y_BldMotion_to_u: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Map_y_BldMotion_to_u, ErrStat2, ErrMsg2, .TRUE. ) ! Map_y_BldMotion_to_u + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Map_y_BldMotion_to_u, ErrStat2, ErrMsg2, .TRUE. ) ! Map_y_BldMotion_to_u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10634,7 +10518,7 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz END IF Int_BufSz = Int_BufSz + 1 ! Un_Sum Int_BufSz = Int_BufSz + 3 ! qp: size of buffers for each call to pack subtype - CALL BD_Packeqmotionqp( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, .TRUE. ) ! qp + CALL BD_PackEqMotionQP( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, .TRUE. ) ! qp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10917,7 +10801,7 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Map_u_DistrLoad_to_y, ErrStat2, ErrMsg2, OnlySize ) ! Map_u_DistrLoad_to_y + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Map_u_DistrLoad_to_y, ErrStat2, ErrMsg2, OnlySize ) ! Map_u_DistrLoad_to_y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10945,7 +10829,7 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Map_y_BldMotion_to_u, ErrStat2, ErrMsg2, OnlySize ) ! Map_y_BldMotion_to_u + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Map_y_BldMotion_to_u, ErrStat2, ErrMsg2, OnlySize ) ! Map_y_BldMotion_to_u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10975,7 +10859,7 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz ENDIF IntKiBuf(Int_Xferred) = InData%Un_Sum Int_Xferred = Int_Xferred + 1 - CALL BD_Packeqmotionqp( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, OnlySize ) ! qp + CALL BD_PackEqMotionQP( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, OnlySize ) ! qp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11889,7 +11773,7 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Map_u_DistrLoad_to_y, ErrStat2, ErrMsg2 ) ! Map_u_DistrLoad_to_y + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%Map_u_DistrLoad_to_y, ErrStat2, ErrMsg2 ) ! Map_u_DistrLoad_to_y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11929,7 +11813,7 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Map_y_BldMotion_to_u, ErrStat2, ErrMsg2 ) ! Map_y_BldMotion_to_u + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%Map_y_BldMotion_to_u, ErrStat2, ErrMsg2 ) ! Map_y_BldMotion_to_u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11971,7 +11855,7 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_Unpackeqmotionqp( Re_Buf, Db_Buf, Int_Buf, OutData%qp, ErrStat2, ErrMsg2 ) ! qp + CALL BD_UnpackEqMotionQP( Re_Buf, Db_Buf, Int_Buf, OutData%qp, ErrStat2, ErrMsg2 ) ! qp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 6f19f87bdb..9c7a4eec8b 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -510,12 +510,12 @@ MODULE ElastoDyn_Types ! ========= ED_OtherStateType ======= TYPE, PUBLIC :: ED_OtherStateType INTEGER(IntKi) :: n !< tracks time step for which OtherState was updated [-] - TYPE(ED_ContinuousStateType) , DIMENSION(ED_NMX) :: xdot !< previous state deriv for multi-step [-] + TYPE(ED_ContinuousStateType) , DIMENSION(1:ED_NMX) :: xdot !< previous state deriv for multi-step [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IC !< Array which stores pointers to predictor-corrector results [-] REAL(ReKi) :: HSSBrTrq !< HSSBrTrq from update states; a hack to get this working with a single integrator [-] REAL(ReKi) :: HSSBrTrqC !< Commanded HSS brake torque (adjusted for sign) [N-m] INTEGER(IntKi) :: SgnPrvLSTQ !< The sign of the low-speed shaft torque from the previous call to RtHS(). This is calculated at the end of RtHS(). NOTE: The low-speed shaft torque is assumed to be positive at the beginning of the run! [-] - INTEGER(IntKi) , DIMENSION(ED_NMX) :: SgnLSTQ !< history of sign of LSTQ [-] + INTEGER(IntKi) , DIMENSION(1:ED_NMX) :: SgnLSTQ !< history of sign of LSTQ [-] END TYPE ED_OtherStateType ! ======================= ! ========= ED_MiscVarType ======= @@ -822,11 +822,6 @@ SUBROUTINE ED_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyInitInput' @@ -843,14 +838,12 @@ SUBROUTINE ED_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth END SUBROUTINE ED_CopyInitInput - SUBROUTINE ED_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ED_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(ED_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyInitInput' @@ -858,12 +851,6 @@ SUBROUTINE ED_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE ED_DestroyInitInput SUBROUTINE ED_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -973,11 +960,6 @@ SUBROUTINE ED_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackInitInput' @@ -1205,14 +1187,12 @@ SUBROUTINE ED_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er ENDIF END SUBROUTINE ED_CopyInitOutput - SUBROUTINE ED_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ED_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(ED_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyInitOutput' @@ -1220,19 +1200,13 @@ SUBROUTINE ED_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) ENDIF IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN DEALLOCATE(InitOutputData%WriteOutputUnt) ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitOutputData%BlPitch)) THEN DEALLOCATE(InitOutputData%BlPitch) @@ -1316,7 +1290,7 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1461,7 +1435,7 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END DO ! I END DO END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1803,7 +1777,7 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2199,14 +2173,12 @@ SUBROUTINE ED_CopyBladeInputData( SrcBladeInputDataData, DstBladeInputDataData, ENDIF END SUBROUTINE ED_CopyBladeInputData - SUBROUTINE ED_DestroyBladeInputData( BladeInputDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ED_DestroyBladeInputData( BladeInputDataData, ErrStat, ErrMsg ) TYPE(BladeInputData), INTENT(INOUT) :: BladeInputDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyBladeInputData' @@ -2214,12 +2186,6 @@ SUBROUTINE ED_DestroyBladeInputData( BladeInputDataData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(BladeInputDataData%BlFract)) THEN DEALLOCATE(BladeInputDataData%BlFract) ENDIF @@ -2776,14 +2742,12 @@ SUBROUTINE ED_CopyBladeMeshInputData( SrcBladeMeshInputDataData, DstBladeMeshInp ENDIF END SUBROUTINE ED_CopyBladeMeshInputData - SUBROUTINE ED_DestroyBladeMeshInputData( BladeMeshInputDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ED_DestroyBladeMeshInputData( BladeMeshInputDataData, ErrStat, ErrMsg ) TYPE(ED_BladeMeshInputData), INTENT(INOUT) :: BladeMeshInputDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyBladeMeshInputData' @@ -2791,12 +2755,6 @@ SUBROUTINE ED_DestroyBladeMeshInputData( BladeMeshInputDataData, ErrStat, ErrMsg ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(BladeMeshInputDataData%RNodes)) THEN DEALLOCATE(BladeMeshInputDataData%RNodes) ENDIF @@ -3367,14 +3325,12 @@ SUBROUTINE ED_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut END SUBROUTINE ED_CopyInputFile - SUBROUTINE ED_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ED_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) TYPE(ED_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyInputFile' @@ -3382,12 +3338,6 @@ SUBROUTINE ED_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputFileData%BlPitch)) THEN DEALLOCATE(InputFileData%BlPitch) ENDIF @@ -3399,14 +3349,14 @@ SUBROUTINE ED_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointe ENDIF IF (ALLOCATED(InputFileData%InpBlMesh)) THEN DO i1 = LBOUND(InputFileData%InpBlMesh,1), UBOUND(InputFileData%InpBlMesh,1) - CALL ED_Destroyblademeshinputdata( InputFileData%InpBlMesh(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyBladeMeshInputData( InputFileData%InpBlMesh(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InputFileData%InpBlMesh) ENDIF IF (ALLOCATED(InputFileData%InpBl)) THEN DO i1 = LBOUND(InputFileData%InpBl,1), UBOUND(InputFileData%InpBl,1) - CALL ED_Destroybladeinputdata( InputFileData%InpBl(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyBladeInputData( InputFileData%InpBl(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InputFileData%InpBl) @@ -3565,7 +3515,7 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%InpBlMesh,1), UBOUND(InData%InpBlMesh,1) Int_BufSz = Int_BufSz + 3 ! InpBlMesh: size of buffers for each call to pack subtype - CALL ED_Packblademeshinputdata( Re_Buf, Db_Buf, Int_Buf, InData%InpBlMesh(i1), ErrStat2, ErrMsg2, .TRUE. ) ! InpBlMesh + CALL ED_PackBladeMeshInputData( Re_Buf, Db_Buf, Int_Buf, InData%InpBlMesh(i1), ErrStat2, ErrMsg2, .TRUE. ) ! InpBlMesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3588,7 +3538,7 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_BufSz = Int_BufSz + 2*1 ! InpBl upper/lower bounds for each dimension DO i1 = LBOUND(InData%InpBl,1), UBOUND(InData%InpBl,1) Int_BufSz = Int_BufSz + 3 ! InpBl: size of buffers for each call to pack subtype - CALL ED_Packbladeinputdata( Re_Buf, Db_Buf, Int_Buf, InData%InpBl(i1), ErrStat2, ErrMsg2, .TRUE. ) ! InpBl + CALL ED_PackBladeInputData( Re_Buf, Db_Buf, Int_Buf, InData%InpBl(i1), ErrStat2, ErrMsg2, .TRUE. ) ! InpBl CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3947,7 +3897,7 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%InpBlMesh,1), UBOUND(InData%InpBlMesh,1) - CALL ED_Packblademeshinputdata( Re_Buf, Db_Buf, Int_Buf, InData%InpBlMesh(i1), ErrStat2, ErrMsg2, OnlySize ) ! InpBlMesh + CALL ED_PackBladeMeshInputData( Re_Buf, Db_Buf, Int_Buf, InData%InpBlMesh(i1), ErrStat2, ErrMsg2, OnlySize ) ! InpBlMesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3988,7 +3938,7 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%InpBl,1), UBOUND(InData%InpBl,1) - CALL ED_Packbladeinputdata( Re_Buf, Db_Buf, Int_Buf, InData%InpBl(i1), ErrStat2, ErrMsg2, OnlySize ) ! InpBl + CALL ED_PackBladeInputData( Re_Buf, Db_Buf, Int_Buf, InData%InpBl(i1), ErrStat2, ErrMsg2, OnlySize ) ! InpBl CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4612,7 +4562,7 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_Unpackblademeshinputdata( Re_Buf, Db_Buf, Int_Buf, OutData%InpBlMesh(i1), ErrStat2, ErrMsg2 ) ! InpBlMesh + CALL ED_UnpackBladeMeshInputData( Re_Buf, Db_Buf, Int_Buf, OutData%InpBlMesh(i1), ErrStat2, ErrMsg2 ) ! InpBlMesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4668,7 +4618,7 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_Unpackbladeinputdata( Re_Buf, Db_Buf, Int_Buf, OutData%InpBl(i1), ErrStat2, ErrMsg2 ) ! InpBl + CALL ED_UnpackBladeInputData( Re_Buf, Db_Buf, Int_Buf, OutData%InpBl(i1), ErrStat2, ErrMsg2 ) ! InpBl CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5384,14 +5334,12 @@ SUBROUTINE ED_CopyCoordSys( SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%z3 = SrcCoordSysData%z3 END SUBROUTINE ED_CopyCoordSys - SUBROUTINE ED_DestroyCoordSys( CoordSysData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ED_DestroyCoordSys( CoordSysData, ErrStat, ErrMsg ) TYPE(ED_CoordSys), INTENT(INOUT) :: CoordSysData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyCoordSys' @@ -5399,12 +5347,6 @@ SUBROUTINE ED_DestroyCoordSys( CoordSysData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(CoordSysData%i1)) THEN DEALLOCATE(CoordSysData%i1) ENDIF @@ -7072,14 +7014,12 @@ SUBROUTINE ED_CopyActiveDOFs( SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Er ENDIF END SUBROUTINE ED_CopyActiveDOFs - SUBROUTINE ED_DestroyActiveDOFs( ActiveDOFsData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ED_DestroyActiveDOFs( ActiveDOFsData, ErrStat, ErrMsg ) TYPE(ED_ActiveDOFs), INTENT(INOUT) :: ActiveDOFsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyActiveDOFs' @@ -7087,12 +7027,6 @@ SUBROUTINE ED_DestroyActiveDOFs( ActiveDOFsData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ActiveDOFsData%NPSBE)) THEN DEALLOCATE(ActiveDOFsData%NPSBE) ENDIF @@ -9017,14 +8951,12 @@ SUBROUTINE ED_CopyRtHndSide( SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSt ENDIF END SUBROUTINE ED_CopyRtHndSide - SUBROUTINE ED_DestroyRtHndSide( RtHndSideData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ED_DestroyRtHndSide( RtHndSideData, ErrStat, ErrMsg ) TYPE(ED_RtHndSide), INTENT(INOUT) :: RtHndSideData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyRtHndSide' @@ -9032,12 +8964,6 @@ SUBROUTINE ED_DestroyRtHndSide( RtHndSideData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(RtHndSideData%rQS)) THEN DEALLOCATE(RtHndSideData%rQS) ENDIF @@ -13947,14 +13873,12 @@ SUBROUTINE ED_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrSt ENDIF END SUBROUTINE ED_CopyContState - SUBROUTINE ED_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ED_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(ED_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyContState' @@ -13962,12 +13886,6 @@ SUBROUTINE ED_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ContStateData%QT)) THEN DEALLOCATE(ContStateData%QT) ENDIF @@ -14162,14 +14080,12 @@ SUBROUTINE ED_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE ED_CopyDiscState - SUBROUTINE ED_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ED_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(ED_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyDiscState' @@ -14177,12 +14093,6 @@ SUBROUTINE ED_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE ED_DestroyDiscState SUBROUTINE ED_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -14299,14 +14209,12 @@ SUBROUTINE ED_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE ED_CopyConstrState - SUBROUTINE ED_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ED_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(ED_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyConstrState' @@ -14314,12 +14222,6 @@ SUBROUTINE ED_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE ED_DestroyConstrState SUBROUTINE ED_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -14458,14 +14360,12 @@ SUBROUTINE ED_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%SgnLSTQ = SrcOtherStateData%SgnLSTQ END SUBROUTINE ED_CopyOtherState - SUBROUTINE ED_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ED_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(ED_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyOtherState' @@ -14473,14 +14373,8 @@ SUBROUTINE ED_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL ED_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO IF (ALLOCATED(OtherStateData%IC)) THEN @@ -14857,14 +14751,12 @@ SUBROUTINE ED_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod END SUBROUTINE ED_CopyMisc - SUBROUTINE ED_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ED_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(ED_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyMisc' @@ -14872,15 +14764,9 @@ SUBROUTINE ED_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL ED_Destroycoordsys( MiscData%CoordSys, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyCoordSys( MiscData%CoordSys, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_Destroyrthndside( MiscData%RtHS, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyRtHndSide( MiscData%RtHS, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MiscData%AllOuts)) THEN DEALLOCATE(MiscData%AllOuts) @@ -14942,7 +14828,7 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! CoordSys: size of buffers for each call to pack subtype - CALL ED_Packcoordsys( Re_Buf, Db_Buf, Int_Buf, InData%CoordSys, ErrStat2, ErrMsg2, .TRUE. ) ! CoordSys + CALL ED_PackCoordSys( Re_Buf, Db_Buf, Int_Buf, InData%CoordSys, ErrStat2, ErrMsg2, .TRUE. ) ! CoordSys CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14959,7 +14845,7 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! RtHS: size of buffers for each call to pack subtype - CALL ED_Packrthndside( Re_Buf, Db_Buf, Int_Buf, InData%RtHS, ErrStat2, ErrMsg2, .TRUE. ) ! RtHS + CALL ED_PackRtHndSide( Re_Buf, Db_Buf, Int_Buf, InData%RtHS, ErrStat2, ErrMsg2, .TRUE. ) ! RtHS CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15038,7 +14924,7 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Db_Xferred = 1 Int_Xferred = 1 - CALL ED_Packcoordsys( Re_Buf, Db_Buf, Int_Buf, InData%CoordSys, ErrStat2, ErrMsg2, OnlySize ) ! CoordSys + CALL ED_PackCoordSys( Re_Buf, Db_Buf, Int_Buf, InData%CoordSys, ErrStat2, ErrMsg2, OnlySize ) ! CoordSys CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15066,7 +14952,7 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL ED_Packrthndside( Re_Buf, Db_Buf, Int_Buf, InData%RtHS, ErrStat2, ErrMsg2, OnlySize ) ! RtHS + CALL ED_PackRtHndSide( Re_Buf, Db_Buf, Int_Buf, InData%RtHS, ErrStat2, ErrMsg2, OnlySize ) ! RtHS CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15274,7 +15160,7 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_Unpackcoordsys( Re_Buf, Db_Buf, Int_Buf, OutData%CoordSys, ErrStat2, ErrMsg2 ) ! CoordSys + CALL ED_UnpackCoordSys( Re_Buf, Db_Buf, Int_Buf, OutData%CoordSys, ErrStat2, ErrMsg2 ) ! CoordSys CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15314,7 +15200,7 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_Unpackrthndside( Re_Buf, Db_Buf, Int_Buf, OutData%RtHS, ErrStat2, ErrMsg2 ) ! RtHS + CALL ED_UnpackRtHndSide( Re_Buf, Db_Buf, Int_Buf, OutData%RtHS, ErrStat2, ErrMsg2 ) ! RtHS CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -16438,14 +16324,12 @@ SUBROUTINE ED_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%Jac_ny = SrcParamData%Jac_ny END SUBROUTINE ED_CopyParam - SUBROUTINE ED_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ED_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(ED_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyParam' @@ -16453,12 +16337,6 @@ SUBROUTINE ED_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%PH)) THEN DEALLOCATE(ParamData%PH) ENDIF @@ -16471,11 +16349,11 @@ SUBROUTINE ED_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(ParamData%DOF_Desc)) THEN DEALLOCATE(ParamData%DOF_Desc) ENDIF - CALL ED_Destroyactivedofs( ParamData%DOFs, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyActiveDOFs( ParamData%DOFs, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) @@ -16629,7 +16507,7 @@ SUBROUTINE ED_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(ParamData%BldNd_OutParam)) THEN DO i1 = LBOUND(ParamData%BldNd_OutParam,1), UBOUND(ParamData%BldNd_OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyOutParmType( ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%BldNd_OutParam) @@ -16711,7 +16589,7 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! DOFs: size of buffers for each call to pack subtype - CALL ED_Packactivedofs( Re_Buf, Db_Buf, Int_Buf, InData%DOFs, ErrStat2, ErrMsg2, .TRUE. ) ! DOFs + CALL ED_PackActiveDOFs( Re_Buf, Db_Buf, Int_Buf, InData%DOFs, ErrStat2, ErrMsg2, .TRUE. ) ! DOFs CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -16736,7 +16614,7 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17148,7 +17026,7 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutParam upper/lower bounds for each dimension DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) Int_BufSz = Int_BufSz + 3 ! BldNd_OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17295,7 +17173,7 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si END DO ! I END DO END IF - CALL ED_Packactivedofs( Re_Buf, Db_Buf, Int_Buf, InData%DOFs, ErrStat2, ErrMsg2, OnlySize ) ! DOFs + CALL ED_PackActiveDOFs( Re_Buf, Db_Buf, Int_Buf, InData%DOFs, ErrStat2, ErrMsg2, OnlySize ) ! DOFs CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17344,7 +17222,7 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18659,7 +18537,7 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18906,7 +18784,7 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_Unpackactivedofs( Re_Buf, Db_Buf, Int_Buf, OutData%DOFs, ErrStat2, ErrMsg2 ) ! DOFs + CALL ED_UnpackActiveDOFs( Re_Buf, Db_Buf, Int_Buf, OutData%DOFs, ErrStat2, ErrMsg2 ) ! DOFs CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18970,7 +18848,7 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20479,7 +20357,7 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_OutParam + CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20635,14 +20513,12 @@ SUBROUTINE ED_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) DstInputData%HSSBrTrqC = SrcInputData%HSSBrTrqC END SUBROUTINE ED_CopyInput - SUBROUTINE ED_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ED_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(ED_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyInput' @@ -20650,12 +20526,6 @@ SUBROUTINE ED_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputData%BladePtLoads)) THEN DO i1 = LBOUND(InputData%BladePtLoads,1), UBOUND(InputData%BladePtLoads,1) CALL MeshDestroy( InputData%BladePtLoads(i1), ErrStat2, ErrMsg2 ) @@ -21576,14 +21446,12 @@ SUBROUTINE ED_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%LSShftFzs = SrcOutputData%LSShftFzs END SUBROUTINE ED_CopyOutput - SUBROUTINE ED_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ED_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(ED_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyOutput' @@ -21591,12 +21459,6 @@ SUBROUTINE ED_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%BladeLn2Mesh)) THEN DO i1 = LBOUND(OutputData%BladeLn2Mesh,1), UBOUND(OutputData%BladeLn2Mesh,1) CALL MeshDestroy( OutputData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2 ) diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index 68f463e0ff..6a6332cdb3 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -163,8 +163,6 @@ SUBROUTINE ExtPtfm_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyInitInput' @@ -177,14 +175,12 @@ SUBROUTINE ExtPtfm_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%RootName = SrcInitInputData%RootName END SUBROUTINE ExtPtfm_CopyInitInput - SUBROUTINE ExtPtfm_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ExtPtfm_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(ExtPtfm_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyInitInput' @@ -192,12 +188,6 @@ SUBROUTINE ExtPtfm_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE ExtPtfm_DestroyInitInput SUBROUTINE ExtPtfm_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -293,8 +283,6 @@ SUBROUTINE ExtPtfm_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackInitInput' @@ -399,14 +387,12 @@ SUBROUTINE ExtPtfm_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ENDIF END SUBROUTINE ExtPtfm_CopyInputFile - SUBROUTINE ExtPtfm_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ExtPtfm_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) TYPE(ExtPtfm_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyInputFile' @@ -414,12 +400,6 @@ SUBROUTINE ExtPtfm_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputFileData%ActiveCBDOF)) THEN DEALLOCATE(InputFileData%ActiveCBDOF) ENDIF @@ -895,14 +875,12 @@ SUBROUTINE ExtPtfm_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCod ENDIF END SUBROUTINE ExtPtfm_CopyInitOutput - SUBROUTINE ExtPtfm_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ExtPtfm_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(ExtPtfm_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyInitOutput' @@ -910,13 +888,7 @@ SUBROUTINE ExtPtfm_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCAT ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) @@ -987,7 +959,7 @@ SUBROUTINE ExtPtfm_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1080,7 +1052,7 @@ SUBROUTINE ExtPtfm_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1330,7 +1302,7 @@ SUBROUTINE ExtPtfm_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1570,14 +1542,12 @@ SUBROUTINE ExtPtfm_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ENDIF END SUBROUTINE ExtPtfm_CopyContState - SUBROUTINE ExtPtfm_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ExtPtfm_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(ExtPtfm_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyContState' @@ -1585,12 +1555,6 @@ SUBROUTINE ExtPtfm_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ContStateData%qm)) THEN DEALLOCATE(ContStateData%qm) ENDIF @@ -1785,14 +1749,12 @@ SUBROUTINE ExtPtfm_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE ExtPtfm_CopyDiscState - SUBROUTINE ExtPtfm_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ExtPtfm_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(ExtPtfm_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyDiscState' @@ -1800,12 +1762,6 @@ SUBROUTINE ExtPtfm_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE ExtPtfm_DestroyDiscState SUBROUTINE ExtPtfm_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1922,14 +1878,12 @@ SUBROUTINE ExtPtfm_CopyConstrState( SrcConstrStateData, DstConstrStateData, Ctrl DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE ExtPtfm_CopyConstrState - SUBROUTINE ExtPtfm_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ExtPtfm_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(ExtPtfm_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyConstrState' @@ -1937,12 +1891,6 @@ SUBROUTINE ExtPtfm_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOC ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE ExtPtfm_DestroyConstrState SUBROUTINE ExtPtfm_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2076,14 +2024,12 @@ SUBROUTINE ExtPtfm_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCod DstOtherStateData%n = SrcOtherStateData%n END SUBROUTINE ExtPtfm_CopyOtherState - SUBROUTINE ExtPtfm_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ExtPtfm_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(ExtPtfm_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyOtherState' @@ -2091,15 +2037,9 @@ SUBROUTINE ExtPtfm_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCAT ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OtherStateData%xdot)) THEN DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL ExtPtfm_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtPtfm_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OtherStateData%xdot) @@ -2381,14 +2321,12 @@ SUBROUTINE ExtPtfm_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE ExtPtfm_CopyMisc - SUBROUTINE ExtPtfm_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ExtPtfm_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyMisc' @@ -2396,12 +2334,6 @@ SUBROUTINE ExtPtfm_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MiscData%xFlat)) THEN DEALLOCATE(MiscData%xFlat) ENDIF @@ -2996,14 +2928,12 @@ SUBROUTINE ExtPtfm_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Err ENDIF END SUBROUTINE ExtPtfm_CopyParam - SUBROUTINE ExtPtfm_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ExtPtfm_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyParam' @@ -3011,12 +2941,6 @@ SUBROUTINE ExtPtfm_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%Mass)) THEN DEALLOCATE(ParamData%Mass) ENDIF @@ -3085,7 +3009,7 @@ SUBROUTINE ExtPtfm_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) @@ -3253,7 +3177,7 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3748,7 +3672,7 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4375,7 +4299,7 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4428,14 +4352,12 @@ SUBROUTINE ExtPtfm_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE ExtPtfm_CopyInput - SUBROUTINE ExtPtfm_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ExtPtfm_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(ExtPtfm_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyInput' @@ -4443,12 +4365,6 @@ SUBROUTINE ExtPtfm_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( InputData%PtfmMesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE ExtPtfm_DestroyInput @@ -4663,14 +4579,12 @@ SUBROUTINE ExtPtfm_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ENDIF END SUBROUTINE ExtPtfm_CopyOutput - SUBROUTINE ExtPtfm_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE ExtPtfm_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyOutput' @@ -4678,12 +4592,6 @@ SUBROUTINE ExtPtfm_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointer ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( OutputData%PtfmMesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(OutputData%WriteOutput)) THEN diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index 46cb3bec12..43ad17b62e 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -235,7 +235,6 @@ SUBROUTINE FEAM_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, Err INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_CopyInputFile' @@ -483,14 +482,12 @@ SUBROUTINE FEAM_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, Err ENDIF END SUBROUTINE FEAM_CopyInputFile - SUBROUTINE FEAM_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FEAM_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) TYPE(FEAM_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyInputFile' @@ -498,12 +495,6 @@ SUBROUTINE FEAM_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputFileData%LineCI)) THEN DEALLOCATE(InputFileData%LineCI) ENDIF @@ -1068,7 +1059,6 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_UnPackInputFile' @@ -1532,14 +1522,12 @@ SUBROUTINE FEAM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WtrDens = SrcInitInputData%WtrDens END SUBROUTINE FEAM_CopyInitInput - SUBROUTINE FEAM_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FEAM_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(FEAM_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyInitInput' @@ -1547,12 +1535,6 @@ SUBROUTINE FEAM_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%WaveAcc0)) THEN DEALLOCATE(InitInputData%WaveAcc0) ENDIF @@ -1973,14 +1955,12 @@ SUBROUTINE FEAM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ENDIF END SUBROUTINE FEAM_CopyInitOutput - SUBROUTINE FEAM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FEAM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(FEAM_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyInitOutput' @@ -1988,19 +1968,13 @@ SUBROUTINE FEAM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) ENDIF IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN DEALLOCATE(InitOutputData%WriteOutputUnt) ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitOutputData%LAnchxi)) THEN DEALLOCATE(InitOutputData%LAnchxi) @@ -2069,7 +2043,7 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2176,7 +2150,7 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err END DO ! I END DO END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2396,7 +2370,7 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2559,14 +2533,12 @@ SUBROUTINE FEAM_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Err ENDIF END SUBROUTINE FEAM_CopyContState - SUBROUTINE FEAM_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FEAM_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(FEAM_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyContState' @@ -2574,12 +2546,6 @@ SUBROUTINE FEAM_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ContStateData%GLU)) THEN DEALLOCATE(ContStateData%GLU) ENDIF @@ -2795,14 +2761,12 @@ SUBROUTINE FEAM_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Err DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE FEAM_CopyDiscState - SUBROUTINE FEAM_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FEAM_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(FEAM_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyDiscState' @@ -2810,12 +2774,6 @@ SUBROUTINE FEAM_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE FEAM_DestroyDiscState SUBROUTINE FEAM_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2934,14 +2892,12 @@ SUBROUTINE FEAM_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCod DstConstrStateData%TZER = SrcConstrStateData%TZER END SUBROUTINE FEAM_CopyConstrState - SUBROUTINE FEAM_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FEAM_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(FEAM_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyConstrState' @@ -2949,12 +2905,6 @@ SUBROUTINE FEAM_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE FEAM_DestroyConstrState SUBROUTINE FEAM_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -3187,14 +3137,12 @@ SUBROUTINE FEAM_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, DstOtherStateData%EMAS0 = SrcOtherStateData%EMAS0 END SUBROUTINE FEAM_CopyOtherState - SUBROUTINE FEAM_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FEAM_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(FEAM_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyOtherState' @@ -3202,12 +3150,6 @@ SUBROUTINE FEAM_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OtherStateData%GLU0)) THEN DEALLOCATE(OtherStateData%GLU0) ENDIF @@ -3866,14 +3808,12 @@ SUBROUTINE FEAM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%LastIndWave = SrcMiscData%LastIndWave END SUBROUTINE FEAM_CopyMisc - SUBROUTINE FEAM_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FEAM_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(FEAM_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyMisc' @@ -3881,12 +3821,6 @@ SUBROUTINE FEAM_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MiscData%GLF)) THEN DEALLOCATE(MiscData%GLF) ENDIF @@ -4990,14 +4924,12 @@ SUBROUTINE FEAM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE FEAM_CopyParam - SUBROUTINE FEAM_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FEAM_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(FEAM_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyParam' @@ -5005,12 +4937,6 @@ SUBROUTINE FEAM_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%NEQ)) THEN DEALLOCATE(ParamData%NEQ) ENDIF @@ -5058,7 +4984,7 @@ SUBROUTINE FEAM_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) @@ -5220,7 +5146,7 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5682,7 +5608,7 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6342,7 +6268,7 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6430,14 +6356,12 @@ SUBROUTINE FEAM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE FEAM_CopyInput - SUBROUTINE FEAM_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FEAM_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(FEAM_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyInput' @@ -6445,12 +6369,6 @@ SUBROUTINE FEAM_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( InputData%HydroForceLineMesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL MeshDestroy( InputData%PtFairleadDisplacement, ErrStat2, ErrMsg2 ) @@ -6755,14 +6673,12 @@ SUBROUTINE FEAM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE FEAM_CopyOutput - SUBROUTINE FEAM_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FEAM_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(FEAM_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyOutput' @@ -6770,12 +6686,6 @@ SUBROUTINE FEAM_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%WriteOutput)) THEN DEALLOCATE(OutputData%WriteOutput) ENDIF diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index 2e506d7241..5dedba9458 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -169,14 +169,12 @@ SUBROUTINE Conv_Rdtn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode DstInitInputData%RdtnTMax = SrcInitInputData%RdtnTMax END SUBROUTINE Conv_Rdtn_CopyInitInput - SUBROUTINE Conv_Rdtn_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Conv_Rdtn_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(Conv_Rdtn_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyInitInput' @@ -184,12 +182,6 @@ SUBROUTINE Conv_Rdtn_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCAT ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%HdroAddMs)) THEN DEALLOCATE(InitInputData%HdroAddMs) ENDIF @@ -510,14 +502,12 @@ SUBROUTINE Conv_Rdtn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%DummyInitOut = SrcInitOutputData%DummyInitOut END SUBROUTINE Conv_Rdtn_CopyInitOutput - SUBROUTINE Conv_Rdtn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Conv_Rdtn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(Conv_Rdtn_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyInitOutput' @@ -525,12 +515,6 @@ SUBROUTINE Conv_Rdtn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOC ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Conv_Rdtn_DestroyInitOutput SUBROUTINE Conv_Rdtn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -647,14 +631,12 @@ SUBROUTINE Conv_Rdtn_CopyContState( SrcContStateData, DstContStateData, CtrlCode DstContStateData%DummyContState = SrcContStateData%DummyContState END SUBROUTINE Conv_Rdtn_CopyContState - SUBROUTINE Conv_Rdtn_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Conv_Rdtn_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(Conv_Rdtn_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyContState' @@ -662,12 +644,6 @@ SUBROUTINE Conv_Rdtn_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCAT ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Conv_Rdtn_DestroyContState SUBROUTINE Conv_Rdtn_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -800,14 +776,12 @@ SUBROUTINE Conv_Rdtn_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode DstDiscStateData%LastTime = SrcDiscStateData%LastTime END SUBROUTINE Conv_Rdtn_CopyDiscState - SUBROUTINE Conv_Rdtn_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Conv_Rdtn_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(Conv_Rdtn_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyDiscState' @@ -815,12 +789,6 @@ SUBROUTINE Conv_Rdtn_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCAT ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(DiscStateData%XDHistory)) THEN DEALLOCATE(DiscStateData%XDHistory) ENDIF @@ -990,14 +958,12 @@ SUBROUTINE Conv_Rdtn_CopyConstrState( SrcConstrStateData, DstConstrStateData, Ct DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE Conv_Rdtn_CopyConstrState - SUBROUTINE Conv_Rdtn_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Conv_Rdtn_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(Conv_Rdtn_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyConstrState' @@ -1005,12 +971,6 @@ SUBROUTINE Conv_Rdtn_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALL ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Conv_Rdtn_DestroyConstrState SUBROUTINE Conv_Rdtn_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1127,14 +1087,12 @@ SUBROUTINE Conv_Rdtn_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlC DstOtherStateData%IndRdtn = SrcOtherStateData%IndRdtn END SUBROUTINE Conv_Rdtn_CopyOtherState - SUBROUTINE Conv_Rdtn_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Conv_Rdtn_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(Conv_Rdtn_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyOtherState' @@ -1142,12 +1100,6 @@ SUBROUTINE Conv_Rdtn_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOC ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Conv_Rdtn_DestroyOtherState SUBROUTINE Conv_Rdtn_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1264,14 +1216,12 @@ SUBROUTINE Conv_Rdtn_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrM DstMiscData%LastIndRdtn = SrcMiscData%LastIndRdtn END SUBROUTINE Conv_Rdtn_CopyMisc - SUBROUTINE Conv_Rdtn_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Conv_Rdtn_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(Conv_Rdtn_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyMisc' @@ -1279,12 +1229,6 @@ SUBROUTINE Conv_Rdtn_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Conv_Rdtn_DestroyMisc SUBROUTINE Conv_Rdtn_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1424,14 +1368,12 @@ SUBROUTINE Conv_Rdtn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, E DstParamData%NStepRdtn1 = SrcParamData%NStepRdtn1 END SUBROUTINE Conv_Rdtn_CopyParam - SUBROUTINE Conv_Rdtn_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Conv_Rdtn_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(Conv_Rdtn_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyParam' @@ -1439,12 +1381,6 @@ SUBROUTINE Conv_Rdtn_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointer ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%RdtnKrnl)) THEN DEALLOCATE(ParamData%RdtnKrnl) ENDIF @@ -1657,14 +1593,12 @@ SUBROUTINE Conv_Rdtn_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, E ENDIF END SUBROUTINE Conv_Rdtn_CopyInput - SUBROUTINE Conv_Rdtn_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Conv_Rdtn_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(Conv_Rdtn_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyInput' @@ -1672,12 +1606,6 @@ SUBROUTINE Conv_Rdtn_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointer ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputData%Velocity)) THEN DEALLOCATE(InputData%Velocity) ENDIF @@ -1843,14 +1771,12 @@ SUBROUTINE Conv_Rdtn_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat ENDIF END SUBROUTINE Conv_Rdtn_CopyOutput - SUBROUTINE Conv_Rdtn_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Conv_Rdtn_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(Conv_Rdtn_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyOutput' @@ -1858,12 +1784,6 @@ SUBROUTINE Conv_Rdtn_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%F_Rdtn)) THEN DEALLOCATE(OutputData%F_Rdtn) ENDIF diff --git a/modules/hydrodyn/src/Current_Types.f90 b/modules/hydrodyn/src/Current_Types.f90 new file mode 100644 index 0000000000..cd0b3ac2e7 --- /dev/null +++ b/modules/hydrodyn/src/Current_Types.f90 @@ -0,0 +1,1946 @@ +!STARTOFREGISTRYGENERATEDFILE 'Current_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 +!********************************************************************************************************************************* +! Current_Types +!................................................................................................................................. +! This file is part of Current. +! +! 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 Current. 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 Current_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE +! ========= Current_InitInputType ======= + TYPE, PUBLIC :: Current_InitInputType + REAL(SiKi) :: CurrSSV0 !< [-] + CHARACTER(80) :: CurrSSDirChr !< [-] + REAL(SiKi) :: CurrSSDir !< [-] + REAL(SiKi) :: CurrNSRef !< [-] + REAL(SiKi) :: CurrNSV0 !< [-] + REAL(SiKi) :: CurrNSDir !< [-] + REAL(SiKi) :: CurrDIV !< [-] + REAL(SiKi) :: CurrDIDir !< [-] + INTEGER(IntKi) :: CurrMod !< [-] + REAL(SiKi) :: WtrDpth !< [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: MorisonNodezi !< [-] + INTEGER(IntKi) :: NMorisonNodes !< [-] + CHARACTER(1024) :: DirRoot !< [-] + END TYPE Current_InitInputType +! ======================= +! ========= Current_InitOutputType ======= + TYPE, PUBLIC :: Current_InitOutputType + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVxi !< [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVyi !< [-] + REAL(SiKi) :: PCurrVxiPz0 !< [-] + REAL(SiKi) :: PCurrVyiPz0 !< [-] + END TYPE Current_InitOutputType +! ======================= +! ========= Current_ContinuousStateType ======= + TYPE, PUBLIC :: Current_ContinuousStateType + REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] + END TYPE Current_ContinuousStateType +! ======================= +! ========= Current_DiscreteStateType ======= + TYPE, PUBLIC :: Current_DiscreteStateType + REAL(SiKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + END TYPE Current_DiscreteStateType +! ======================= +! ========= Current_ConstraintStateType ======= + TYPE, PUBLIC :: Current_ConstraintStateType + REAL(SiKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + END TYPE Current_ConstraintStateType +! ======================= +! ========= Current_OtherStateType ======= + TYPE, PUBLIC :: Current_OtherStateType + INTEGER(IntKi) :: DummyOtherState !< Remove this variable if you have other states [-] + END TYPE Current_OtherStateType +! ======================= +! ========= Current_MiscVarType ======= + TYPE, PUBLIC :: Current_MiscVarType + REAL(ReKi) :: DummyMiscVar !< Remove this variable if you have misc/optimization variables [-] + END TYPE Current_MiscVarType +! ======================= +! ========= Current_ParameterType ======= + TYPE, PUBLIC :: Current_ParameterType + REAL(DbKi) :: DT !< Time step for continuous state integration and discrete state update [seconds] + END TYPE Current_ParameterType +! ======================= +! ========= Current_InputType ======= + TYPE, PUBLIC :: Current_InputType + REAL(SiKi) :: DummyInput !< Remove this variable if you have input data [-] + END TYPE Current_InputType +! ======================= +! ========= Current_OutputType ======= + TYPE, PUBLIC :: Current_OutputType + REAL(SiKi) :: DummyOutput !< Remove this variable if you have output data [-] + END TYPE Current_OutputType +! ======================= +CONTAINS + SUBROUTINE Current_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Current_InitInputType), INTENT(IN) :: SrcInitInputData + TYPE(Current_InitInputType), INTENT(INOUT) :: DstInitInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyInitInput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInitInputData%CurrSSV0 = SrcInitInputData%CurrSSV0 + DstInitInputData%CurrSSDirChr = SrcInitInputData%CurrSSDirChr + DstInitInputData%CurrSSDir = SrcInitInputData%CurrSSDir + DstInitInputData%CurrNSRef = SrcInitInputData%CurrNSRef + DstInitInputData%CurrNSV0 = SrcInitInputData%CurrNSV0 + DstInitInputData%CurrNSDir = SrcInitInputData%CurrNSDir + DstInitInputData%CurrDIV = SrcInitInputData%CurrDIV + DstInitInputData%CurrDIDir = SrcInitInputData%CurrDIDir + DstInitInputData%CurrMod = SrcInitInputData%CurrMod + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth +IF (ALLOCATED(SrcInitInputData%MorisonNodezi)) THEN + i1_l = LBOUND(SrcInitInputData%MorisonNodezi,1) + i1_u = UBOUND(SrcInitInputData%MorisonNodezi,1) + IF (.NOT. ALLOCATED(DstInitInputData%MorisonNodezi)) THEN + ALLOCATE(DstInitInputData%MorisonNodezi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MorisonNodezi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%MorisonNodezi = SrcInitInputData%MorisonNodezi +ENDIF + DstInitInputData%NMorisonNodes = SrcInitInputData%NMorisonNodes + DstInitInputData%DirRoot = SrcInitInputData%DirRoot + END SUBROUTINE Current_CopyInitInput + + SUBROUTINE Current_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + TYPE(Current_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyInitInput' + + ErrStat = ErrID_None + ErrMsg = "" + +IF (ALLOCATED(InitInputData%MorisonNodezi)) THEN + DEALLOCATE(InitInputData%MorisonNodezi) +ENDIF + END SUBROUTINE Current_DestroyInitInput + + SUBROUTINE Current_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Current_InitInputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackInitInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! CurrSSV0 + Int_BufSz = Int_BufSz + 1*LEN(InData%CurrSSDirChr) ! CurrSSDirChr + Re_BufSz = Re_BufSz + 1 ! CurrSSDir + Re_BufSz = Re_BufSz + 1 ! CurrNSRef + Re_BufSz = Re_BufSz + 1 ! CurrNSV0 + Re_BufSz = Re_BufSz + 1 ! CurrNSDir + Re_BufSz = Re_BufSz + 1 ! CurrDIV + Re_BufSz = Re_BufSz + 1 ! CurrDIDir + Int_BufSz = Int_BufSz + 1 ! CurrMod + Re_BufSz = Re_BufSz + 1 ! WtrDpth + Int_BufSz = Int_BufSz + 1 ! MorisonNodezi allocated yes/no + IF ( ALLOCATED(InData%MorisonNodezi) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! MorisonNodezi upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%MorisonNodezi) ! MorisonNodezi + END IF + Int_BufSz = Int_BufSz + 1 ! NMorisonNodes + Int_BufSz = Int_BufSz + 1*LEN(InData%DirRoot) ! DirRoot + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%CurrSSV0 + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%CurrSSDirChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%CurrSSDirChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%CurrSSDir + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrNSRef + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrNSV0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrNSDir + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrDIV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrDIDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CurrMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%MorisonNodezi) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MorisonNodezi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MorisonNodezi,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%MorisonNodezi,1), UBOUND(InData%MorisonNodezi,1) + ReKiBuf(Re_Xferred) = InData%MorisonNodezi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NMorisonNodes + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%DirRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END SUBROUTINE Current_PackInitInput + + SUBROUTINE Current_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Current_InitInputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackInitInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%CurrSSV0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%CurrSSDirChr) + OutData%CurrSSDirChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CurrSSDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrNSRef = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrNSV0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrNSDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrDIV = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrDIDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MorisonNodezi not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%MorisonNodezi)) DEALLOCATE(OutData%MorisonNodezi) + ALLOCATE(OutData%MorisonNodezi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonNodezi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%MorisonNodezi,1), UBOUND(OutData%MorisonNodezi,1) + OutData%MorisonNodezi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%NMorisonNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%DirRoot) + OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END SUBROUTINE Current_UnPackInitInput + + SUBROUTINE Current_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Current_InitOutputType), INTENT(IN) :: SrcInitOutputData + TYPE(Current_InitOutputType), INTENT(INOUT) :: DstInitOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyInitOutput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcInitOutputData%CurrVxi)) THEN + i1_l = LBOUND(SrcInitOutputData%CurrVxi,1) + i1_u = UBOUND(SrcInitOutputData%CurrVxi,1) + IF (.NOT. ALLOCATED(DstInitOutputData%CurrVxi)) THEN + ALLOCATE(DstInitOutputData%CurrVxi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CurrVxi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%CurrVxi = SrcInitOutputData%CurrVxi +ENDIF +IF (ALLOCATED(SrcInitOutputData%CurrVyi)) THEN + i1_l = LBOUND(SrcInitOutputData%CurrVyi,1) + i1_u = UBOUND(SrcInitOutputData%CurrVyi,1) + IF (.NOT. ALLOCATED(DstInitOutputData%CurrVyi)) THEN + ALLOCATE(DstInitOutputData%CurrVyi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CurrVyi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%CurrVyi = SrcInitOutputData%CurrVyi +ENDIF + DstInitOutputData%PCurrVxiPz0 = SrcInitOutputData%PCurrVxiPz0 + DstInitOutputData%PCurrVyiPz0 = SrcInitOutputData%PCurrVyiPz0 + END SUBROUTINE Current_CopyInitOutput + + SUBROUTINE Current_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + TYPE(Current_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyInitOutput' + + ErrStat = ErrID_None + ErrMsg = "" + +IF (ALLOCATED(InitOutputData%CurrVxi)) THEN + DEALLOCATE(InitOutputData%CurrVxi) +ENDIF +IF (ALLOCATED(InitOutputData%CurrVyi)) THEN + DEALLOCATE(InitOutputData%CurrVyi) +ENDIF + END SUBROUTINE Current_DestroyInitOutput + + SUBROUTINE Current_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Current_InitOutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackInitOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! CurrVxi allocated yes/no + IF ( ALLOCATED(InData%CurrVxi) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! CurrVxi upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CurrVxi) ! CurrVxi + END IF + Int_BufSz = Int_BufSz + 1 ! CurrVyi allocated yes/no + IF ( ALLOCATED(InData%CurrVyi) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! CurrVyi upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CurrVyi) ! CurrVyi + END IF + Re_BufSz = Re_BufSz + 1 ! PCurrVxiPz0 + Re_BufSz = Re_BufSz + 1 ! PCurrVyiPz0 + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%CurrVxi) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CurrVxi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVxi,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%CurrVxi,1), UBOUND(InData%CurrVxi,1) + ReKiBuf(Re_Xferred) = InData%CurrVxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%CurrVyi) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CurrVyi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVyi,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%CurrVyi,1), UBOUND(InData%CurrVyi,1) + ReKiBuf(Re_Xferred) = InData%CurrVyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%PCurrVxiPz0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PCurrVyiPz0 + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Current_PackInitOutput + + SUBROUTINE Current_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Current_InitOutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackInitOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVxi not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CurrVxi)) DEALLOCATE(OutData%CurrVxi) + ALLOCATE(OutData%CurrVxi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%CurrVxi,1), UBOUND(OutData%CurrVxi,1) + OutData%CurrVxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVyi not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CurrVyi)) DEALLOCATE(OutData%CurrVyi) + ALLOCATE(OutData%CurrVyi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%CurrVyi,1), UBOUND(OutData%CurrVyi,1) + OutData%CurrVyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%PCurrVxiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%PCurrVyiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Current_UnPackInitOutput + + SUBROUTINE Current_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Current_ContinuousStateType), INTENT(IN) :: SrcContStateData + TYPE(Current_ContinuousStateType), INTENT(INOUT) :: DstContStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyContState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstContStateData%DummyContState = SrcContStateData%DummyContState + END SUBROUTINE Current_CopyContState + + SUBROUTINE Current_DestroyContState( ContStateData, ErrStat, ErrMsg ) + TYPE(Current_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyContState' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Current_DestroyContState + + SUBROUTINE Current_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Current_ContinuousStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackContState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyContState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Current_PackContState + + SUBROUTINE Current_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Current_ContinuousStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackContState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Current_UnPackContState + + SUBROUTINE Current_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Current_DiscreteStateType), INTENT(IN) :: SrcDiscStateData + TYPE(Current_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyDiscState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState + END SUBROUTINE Current_CopyDiscState + + SUBROUTINE Current_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + TYPE(Current_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyDiscState' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Current_DestroyDiscState + + SUBROUTINE Current_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Current_DiscreteStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackDiscState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyDiscState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Current_PackDiscState + + SUBROUTINE Current_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Current_DiscreteStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackDiscState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Current_UnPackDiscState + + SUBROUTINE Current_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Current_ConstraintStateType), INTENT(IN) :: SrcConstrStateData + TYPE(Current_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyConstrState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState + END SUBROUTINE Current_CopyConstrState + + SUBROUTINE Current_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + TYPE(Current_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyConstrState' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Current_DestroyConstrState + + SUBROUTINE Current_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Current_ConstraintStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackConstrState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyConstrState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Current_PackConstrState + + SUBROUTINE Current_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Current_ConstraintStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackConstrState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Current_UnPackConstrState + + SUBROUTINE Current_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Current_OtherStateType), INTENT(IN) :: SrcOtherStateData + TYPE(Current_OtherStateType), INTENT(INOUT) :: DstOtherStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyOtherState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState + END SUBROUTINE Current_CopyOtherState + + SUBROUTINE Current_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + TYPE(Current_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyOtherState' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Current_DestroyOtherState + + SUBROUTINE Current_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Current_OtherStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackOtherState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! DummyOtherState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Current_PackOtherState + + SUBROUTINE Current_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Current_OtherStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackOtherState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Current_UnPackOtherState + + SUBROUTINE Current_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Current_MiscVarType), INTENT(IN) :: SrcMiscData + TYPE(Current_MiscVarType), INTENT(INOUT) :: DstMiscData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyMisc' +! + ErrStat = ErrID_None + ErrMsg = "" + DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar + END SUBROUTINE Current_CopyMisc + + SUBROUTINE Current_DestroyMisc( MiscData, ErrStat, ErrMsg ) + TYPE(Current_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyMisc' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Current_DestroyMisc + + SUBROUTINE Current_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Current_MiscVarType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackMisc' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyMiscVar + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyMiscVar + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Current_PackMisc + + SUBROUTINE Current_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Current_MiscVarType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackMisc' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyMiscVar = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Current_UnPackMisc + + SUBROUTINE Current_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Current_ParameterType), INTENT(IN) :: SrcParamData + TYPE(Current_ParameterType), INTENT(INOUT) :: DstParamData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyParam' +! + ErrStat = ErrID_None + ErrMsg = "" + DstParamData%DT = SrcParamData%DT + END SUBROUTINE Current_CopyParam + + SUBROUTINE Current_DestroyParam( ParamData, ErrStat, ErrMsg ) + TYPE(Current_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyParam' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Current_DestroyParam + + SUBROUTINE Current_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Current_ParameterType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackParam' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Db_BufSz = Db_BufSz + 1 ! DT + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + END SUBROUTINE Current_PackParam + + SUBROUTINE Current_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Current_ParameterType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackParam' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END SUBROUTINE Current_UnPackParam + + SUBROUTINE Current_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Current_InputType), INTENT(IN) :: SrcInputData + TYPE(Current_InputType), INTENT(INOUT) :: DstInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyInput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInputData%DummyInput = SrcInputData%DummyInput + END SUBROUTINE Current_CopyInput + + SUBROUTINE Current_DestroyInput( InputData, ErrStat, ErrMsg ) + TYPE(Current_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyInput' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Current_DestroyInput + + SUBROUTINE Current_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Current_InputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyInput + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyInput + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Current_PackInput + + SUBROUTINE Current_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Current_InputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyInput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Current_UnPackInput + + SUBROUTINE Current_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Current_OutputType), INTENT(IN) :: SrcOutputData + TYPE(Current_OutputType), INTENT(INOUT) :: DstOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyOutput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstOutputData%DummyOutput = SrcOutputData%DummyOutput + END SUBROUTINE Current_CopyOutput + + SUBROUTINE Current_DestroyOutput( OutputData, ErrStat, ErrMsg ) + TYPE(Current_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyOutput' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Current_DestroyOutput + + SUBROUTINE Current_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Current_OutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyOutput + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyOutput + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Current_PackOutput + + SUBROUTINE Current_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Current_OutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyOutput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Current_UnPackOutput + + + SUBROUTINE Current_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(Current_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs + TYPE(Current_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Current_Input_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .ne. size(u)) then + CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) + RETURN + endif + order = SIZE(u) - 1 + IF ( order .eq. 0 ) THEN + CALL Current_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL Current_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 2 ) THEN + CALL Current_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE + CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) + RETURN + ENDIF + END SUBROUTINE Current_Input_ExtrapInterp + + + SUBROUTINE Current_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = u1, f(t2) = u2 +! +!.................................................................................................................................. + + TYPE(Current_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(Current_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(Current_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Current_Input_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) + b = -(u1%DummyInput - u2%DummyInput) + u_out%DummyInput = u1%DummyInput + b * ScaleFactor + END SUBROUTINE Current_Input_ExtrapInterp1 + + + SUBROUTINE Current_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 +! +!.................................................................................................................................. + + TYPE(Current_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(Current_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(Current_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(Current_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Current_Input_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor + c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor + u_out%DummyInput = u1%DummyInput + b + c * t_out + END SUBROUTINE Current_Input_ExtrapInterp2 + + + SUBROUTINE Current_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(Current_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs + TYPE(Current_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Current_Output_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .ne. size(y)) then + CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) + RETURN + endif + order = SIZE(y) - 1 + IF ( order .eq. 0 ) THEN + CALL Current_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL Current_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 2 ) THEN + CALL Current_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE + CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) + RETURN + ENDIF + END SUBROUTINE Current_Output_ExtrapInterp + + + SUBROUTINE Current_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = y1, f(t2) = y2 +! +!.................................................................................................................................. + + TYPE(Current_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(Current_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(Current_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Current_Output_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) + b = -(y1%DummyOutput - y2%DummyOutput) + y_out%DummyOutput = y1%DummyOutput + b * ScaleFactor + END SUBROUTINE Current_Output_ExtrapInterp1 + + + SUBROUTINE Current_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 +! +!.................................................................................................................................. + + TYPE(Current_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(Current_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(Current_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(Current_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Current_Output_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))* scaleFactor + c = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) * scaleFactor + y_out%DummyOutput = y1%DummyOutput + b + c * t_out + END SUBROUTINE Current_Output_ExtrapInterp2 + +END MODULE Current_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index bb2d3f23e7..4a1e16a772 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -914,8 +914,8 @@ SUBROUTINE CleanUp() ! NOTE: All of the pointer data originated in SeaState, and SeaState is responsible for deallocating the data ! all other modules are responsible for nullifying their versions of the pointers when they are done with the data - CALL HydroDyn_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2, DEALLOCATEpointers=.false. ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL NWTC_Library_DestroyFileInfoType(InFileInfo,ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL HydroDyn_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL NWTC_Library_DestroyFileInfoType(InFileInfo,ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END SUBROUTINE CleanUp !................................ @@ -963,27 +963,27 @@ SUBROUTINE HydroDyn_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ! Destroy the input data: (ignore errors) - CALL HydroDyn_DestroyInput( u, ErrStat2, ErrMsg2, DEALLOCATEpointers=.not. p%PointsToSeaState ) + CALL HydroDyn_DestroyInput( u, ErrStat2, ErrMsg2 ) ! Destroy the parameter data: (ignore errors) ! Need to nullify pointers so that SeaState module data is not deallocated by HD (i.e., use DEALLOCATEpointers=.false. when it points to SeaState data) ! on restart, the data is a separate copy of the SeaState module data, hence the PointsToSeaState parameter - CALL HydroDyn_DestroyParam( p, ErrStat2, ErrMsg2, DEALLOCATEpointers=.not. p%PointsToSeaState ) + CALL HydroDyn_DestroyParam( p, ErrStat2, ErrMsg2 ) ! Destroy the state data: (ignore errors) - CALL HydroDyn_DestroyContState( x, ErrStat2, ErrMsg2, DEALLOCATEpointers=.not. p%PointsToSeaState ) - CALL HydroDyn_DestroyDiscState( xd, ErrStat2, ErrMsg2, DEALLOCATEpointers=.not. p%PointsToSeaState ) - CALL HydroDyn_DestroyConstrState( z, ErrStat2, ErrMsg2, DEALLOCATEpointers=.not. p%PointsToSeaState ) - CALL HydroDyn_DestroyOtherState( OtherState, ErrStat2, ErrMsg2, DEALLOCATEpointers=.not. p%PointsToSeaState ) + CALL HydroDyn_DestroyContState( x, ErrStat2, ErrMsg2 ) + CALL HydroDyn_DestroyDiscState( xd, ErrStat2, ErrMsg2 ) + CALL HydroDyn_DestroyConstrState( z, ErrStat2, ErrMsg2 ) + CALL HydroDyn_DestroyOtherState( OtherState, ErrStat2, ErrMsg2 ) ! Destroy misc variables: (ignore errors) - CALL HydroDyn_DestroyMisc( m, ErrStat2, ErrMsg2, DEALLOCATEpointers=.not. p%PointsToSeaState ) + CALL HydroDyn_DestroyMisc( m, ErrStat2, ErrMsg2 ) ! Destroy the output data: (ignore errors) - CALL HydroDyn_DestroyOutput( y, ErrStat2, ErrMsg2, DEALLOCATEpointers=.not. p%PointsToSeaState ) + CALL HydroDyn_DestroyOutput( y, ErrStat2, ErrMsg2 ) END SUBROUTINE HydroDyn_End diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index 05836f92ac..ec1e8b50a5 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -206,10 +206,10 @@ PROGRAM HydroDynDriver ! Destroy InitInput and InitOutput data (and nullify pointers to SeaState data) - CALL SeaSt_DestroyInitInput( InitInData_SeaSt, ErrStat, ErrMsg, DEALLOCATEpointers=.false. ); CALL CheckError() - CALL SeaSt_DestroyInitOutput( InitOutData_SeaSt, ErrStat, ErrMsg, DEALLOCATEpointers=.false. ); CALL CheckError() - CALL HydroDyn_DestroyInitInput( InitInData_HD, ErrStat, ErrMsg, DEALLOCATEpointers=.false. ); CALL CheckError() - CALL HydroDyn_DestroyInitOutput( InitOutData_HD, ErrStat, ErrMsg, DEALLOCATEpointers=.false. ); CALL CheckError() + CALL SeaSt_DestroyInitInput( InitInData_SeaSt, ErrStat, ErrMsg ); CALL CheckError() + CALL SeaSt_DestroyInitOutput( InitOutData_SeaSt, ErrStat, ErrMsg ); CALL CheckError() + CALL HydroDyn_DestroyInitInput( InitInData_HD, ErrStat, ErrMsg ); CALL CheckError() + CALL HydroDyn_DestroyInitOutput( InitOutData_HD, ErrStat, ErrMsg ); CALL CheckError() ! Create Mesh mappings @@ -409,13 +409,13 @@ subroutine HD_DvrEnd() end if ! Destroy Initialization data - CALL SeaSt_DestroyInitOutput( InitOutData_SeaSt, ErrStat2, ErrMsg2, DEALLOCATEpointers=.false. ) + CALL SeaSt_DestroyInitOutput( InitOutData_SeaSt, ErrStat2, ErrMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - CALL SeaSt_DestroyInitInput( InitInData_SeaSt, ErrStat2, ErrMsg2, DEALLOCATEpointers=.false. ) + CALL SeaSt_DestroyInitInput( InitInData_SeaSt, ErrStat2, ErrMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - CALL HydroDyn_DestroyInitInput( InitInData_HD, ErrStat2, ErrMsg2, DEALLOCATEpointers=.false. ) + CALL HydroDyn_DestroyInitInput( InitInData_HD, ErrStat2, ErrMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - CALL HydroDyn_DestroyInitOutput( InitOutData_HD, ErrStat2, ErrMsg2, DEALLOCATEpointers=.false. ) + CALL HydroDyn_DestroyInitOutput( InitOutData_HD, ErrStat2, ErrMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) ! Destroy copies of HD data diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 70b901820c..e8cf17e310 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -31,6 +31,9 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE HydroDyn_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE Conv_Radiation_Types +USE SS_Radiation_Types +USE SS_Excitation_Types USE WAMIT_Types USE WAMIT2_Types USE Morison_Types @@ -256,8 +259,6 @@ SUBROUTINE HydroDyn_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyInputFile' @@ -488,14 +489,12 @@ SUBROUTINE HydroDyn_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%OutSFmt = SrcInputFileData%OutSFmt END SUBROUTINE HydroDyn_CopyInputFile - SUBROUTINE HydroDyn_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE HydroDyn_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) TYPE(HydroDyn_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyInputFile' @@ -503,12 +502,6 @@ SUBROUTINE HydroDyn_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputFileData%AddF0)) THEN DEALLOCATE(InputFileData%AddF0) ENDIF @@ -521,7 +514,7 @@ SUBROUTINE HydroDyn_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATE IF (ALLOCATED(InputFileData%AddBQuad)) THEN DEALLOCATE(InputFileData%AddBQuad) ENDIF - CALL SeaSt_DestroyInitInput( InputFileData%SeaState, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_DestroyInitInput( InputFileData%SeaState, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InputFileData%PotFile)) THEN DEALLOCATE(InputFileData%PotFile) @@ -550,11 +543,11 @@ SUBROUTINE HydroDyn_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATE IF (ALLOCATED(InputFileData%PtfmCOByt)) THEN DEALLOCATE(InputFileData%PtfmCOByt) ENDIF - CALL WAMIT_DestroyInitInput( InputFileData%WAMIT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WAMIT_DestroyInitInput( InputFileData%WAMIT, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WAMIT2_DestroyInitInput( InputFileData%WAMIT2, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WAMIT2_DestroyInitInput( InputFileData%WAMIT2, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Morison_DestroyInitInput( InputFileData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyInitInput( InputFileData%Morison, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InputFileData%UserOutputs)) THEN DEALLOCATE(InputFileData%UserOutputs) @@ -1218,8 +1211,6 @@ SUBROUTINE HydroDyn_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackInputFile' @@ -1788,38 +1779,8 @@ SUBROUTINE HydroDyn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS DstInitInputData%InvalidWithSSExctn = SrcInitInputData%InvalidWithSSExctn -IF (ASSOCIATED(SrcInitInputData%WaveElev1)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElev1,1) - i1_u = UBOUND(SrcInitInputData%WaveElev1,1) - i2_l = LBOUND(SrcInitInputData%WaveElev1,2) - i2_u = UBOUND(SrcInitInputData%WaveElev1,2) - i3_l = LBOUND(SrcInitInputData%WaveElev1,3) - i3_u = UBOUND(SrcInitInputData%WaveElev1,3) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveElev1)) THEN - ALLOCATE(DstInitInputData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElev1 = SrcInitInputData%WaveElev1 -ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveElev2)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElev2,1) - i1_u = UBOUND(SrcInitInputData%WaveElev2,1) - i2_l = LBOUND(SrcInitInputData%WaveElev2,2) - i2_u = UBOUND(SrcInitInputData%WaveElev2,2) - i3_l = LBOUND(SrcInitInputData%WaveElev2,3) - i3_u = UBOUND(SrcInitInputData%WaveElev2,3) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveElev2)) THEN - ALLOCATE(DstInitInputData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElev2 = SrcInitInputData%WaveElev2 -ENDIF + DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 + DstInitInputData%WaveElev2 => SrcInitInputData%WaveElev2 IF (ALLOCATED(SrcInitInputData%WaveElev0)) THEN i1_l = LBOUND(SrcInitInputData%WaveElev0,1) i1_u = UBOUND(SrcInitInputData%WaveElev0,1) @@ -1832,180 +1793,16 @@ SUBROUTINE HydroDyn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, END IF DstInitInputData%WaveElev0 = SrcInitInputData%WaveElev0 ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveTime)) THEN - i1_l = LBOUND(SrcInitInputData%WaveTime,1) - i1_u = UBOUND(SrcInitInputData%WaveTime,1) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveTime)) THEN - ALLOCATE(DstInitInputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveTime = SrcInitInputData%WaveTime -ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveDynP)) THEN - i1_l = LBOUND(SrcInitInputData%WaveDynP,1) - i1_u = UBOUND(SrcInitInputData%WaveDynP,1) - i2_l = LBOUND(SrcInitInputData%WaveDynP,2) - i2_u = UBOUND(SrcInitInputData%WaveDynP,2) - i3_l = LBOUND(SrcInitInputData%WaveDynP,3) - i3_u = UBOUND(SrcInitInputData%WaveDynP,3) - i4_l = LBOUND(SrcInitInputData%WaveDynP,4) - i4_u = UBOUND(SrcInitInputData%WaveDynP,4) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveDynP)) THEN - ALLOCATE(DstInitInputData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveDynP = SrcInitInputData%WaveDynP -ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveAcc)) THEN - i1_l = LBOUND(SrcInitInputData%WaveAcc,1) - i1_u = UBOUND(SrcInitInputData%WaveAcc,1) - i2_l = LBOUND(SrcInitInputData%WaveAcc,2) - i2_u = UBOUND(SrcInitInputData%WaveAcc,2) - i3_l = LBOUND(SrcInitInputData%WaveAcc,3) - i3_u = UBOUND(SrcInitInputData%WaveAcc,3) - i4_l = LBOUND(SrcInitInputData%WaveAcc,4) - i4_u = UBOUND(SrcInitInputData%WaveAcc,4) - i5_l = LBOUND(SrcInitInputData%WaveAcc,5) - i5_u = UBOUND(SrcInitInputData%WaveAcc,5) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveAcc)) THEN - ALLOCATE(DstInitInputData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveAcc = SrcInitInputData%WaveAcc -ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveAccMCF)) THEN - i1_l = LBOUND(SrcInitInputData%WaveAccMCF,1) - i1_u = UBOUND(SrcInitInputData%WaveAccMCF,1) - i2_l = LBOUND(SrcInitInputData%WaveAccMCF,2) - i2_u = UBOUND(SrcInitInputData%WaveAccMCF,2) - i3_l = LBOUND(SrcInitInputData%WaveAccMCF,3) - i3_u = UBOUND(SrcInitInputData%WaveAccMCF,3) - i4_l = LBOUND(SrcInitInputData%WaveAccMCF,4) - i4_u = UBOUND(SrcInitInputData%WaveAccMCF,4) - i5_l = LBOUND(SrcInitInputData%WaveAccMCF,5) - i5_u = UBOUND(SrcInitInputData%WaveAccMCF,5) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveAccMCF)) THEN - ALLOCATE(DstInitInputData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveAccMCF = SrcInitInputData%WaveAccMCF -ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveVel)) THEN - i1_l = LBOUND(SrcInitInputData%WaveVel,1) - i1_u = UBOUND(SrcInitInputData%WaveVel,1) - i2_l = LBOUND(SrcInitInputData%WaveVel,2) - i2_u = UBOUND(SrcInitInputData%WaveVel,2) - i3_l = LBOUND(SrcInitInputData%WaveVel,3) - i3_u = UBOUND(SrcInitInputData%WaveVel,3) - i4_l = LBOUND(SrcInitInputData%WaveVel,4) - i4_u = UBOUND(SrcInitInputData%WaveVel,4) - i5_l = LBOUND(SrcInitInputData%WaveVel,5) - i5_u = UBOUND(SrcInitInputData%WaveVel,5) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveVel)) THEN - ALLOCATE(DstInitInputData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveVel = SrcInitInputData%WaveVel -ENDIF -IF (ASSOCIATED(SrcInitInputData%PWaveDynP0)) THEN - i1_l = LBOUND(SrcInitInputData%PWaveDynP0,1) - i1_u = UBOUND(SrcInitInputData%PWaveDynP0,1) - i2_l = LBOUND(SrcInitInputData%PWaveDynP0,2) - i2_u = UBOUND(SrcInitInputData%PWaveDynP0,2) - i3_l = LBOUND(SrcInitInputData%PWaveDynP0,3) - i3_u = UBOUND(SrcInitInputData%PWaveDynP0,3) - IF (.NOT. ASSOCIATED(DstInitInputData%PWaveDynP0)) THEN - ALLOCATE(DstInitInputData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PWaveDynP0 = SrcInitInputData%PWaveDynP0 -ENDIF -IF (ASSOCIATED(SrcInitInputData%PWaveAcc0)) THEN - i1_l = LBOUND(SrcInitInputData%PWaveAcc0,1) - i1_u = UBOUND(SrcInitInputData%PWaveAcc0,1) - i2_l = LBOUND(SrcInitInputData%PWaveAcc0,2) - i2_u = UBOUND(SrcInitInputData%PWaveAcc0,2) - i3_l = LBOUND(SrcInitInputData%PWaveAcc0,3) - i3_u = UBOUND(SrcInitInputData%PWaveAcc0,3) - i4_l = LBOUND(SrcInitInputData%PWaveAcc0,4) - i4_u = UBOUND(SrcInitInputData%PWaveAcc0,4) - IF (.NOT. ASSOCIATED(DstInitInputData%PWaveAcc0)) THEN - ALLOCATE(DstInitInputData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PWaveAcc0 = SrcInitInputData%PWaveAcc0 -ENDIF -IF (ASSOCIATED(SrcInitInputData%PWaveAccMCF0)) THEN - i1_l = LBOUND(SrcInitInputData%PWaveAccMCF0,1) - i1_u = UBOUND(SrcInitInputData%PWaveAccMCF0,1) - i2_l = LBOUND(SrcInitInputData%PWaveAccMCF0,2) - i2_u = UBOUND(SrcInitInputData%PWaveAccMCF0,2) - i3_l = LBOUND(SrcInitInputData%PWaveAccMCF0,3) - i3_u = UBOUND(SrcInitInputData%PWaveAccMCF0,3) - i4_l = LBOUND(SrcInitInputData%PWaveAccMCF0,4) - i4_u = UBOUND(SrcInitInputData%PWaveAccMCF0,4) - IF (.NOT. ASSOCIATED(DstInitInputData%PWaveAccMCF0)) THEN - ALLOCATE(DstInitInputData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PWaveAccMCF0 = SrcInitInputData%PWaveAccMCF0 -ENDIF -IF (ASSOCIATED(SrcInitInputData%PWaveVel0)) THEN - i1_l = LBOUND(SrcInitInputData%PWaveVel0,1) - i1_u = UBOUND(SrcInitInputData%PWaveVel0,1) - i2_l = LBOUND(SrcInitInputData%PWaveVel0,2) - i2_u = UBOUND(SrcInitInputData%PWaveVel0,2) - i3_l = LBOUND(SrcInitInputData%PWaveVel0,3) - i3_u = UBOUND(SrcInitInputData%PWaveVel0,3) - i4_l = LBOUND(SrcInitInputData%PWaveVel0,4) - i4_u = UBOUND(SrcInitInputData%PWaveVel0,4) - IF (.NOT. ASSOCIATED(DstInitInputData%PWaveVel0)) THEN - ALLOCATE(DstInitInputData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PWaveVel0 = SrcInitInputData%PWaveVel0 -ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveElevC0)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevC0,1) - i1_u = UBOUND(SrcInitInputData%WaveElevC0,1) - i2_l = LBOUND(SrcInitInputData%WaveElevC0,2) - i2_u = UBOUND(SrcInitInputData%WaveElevC0,2) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveElevC0)) THEN - ALLOCATE(DstInitInputData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevC0 = SrcInitInputData%WaveElevC0 -ENDIF + DstInitInputData%WaveTime => SrcInitInputData%WaveTime + DstInitInputData%WaveDynP => SrcInitInputData%WaveDynP + DstInitInputData%WaveAcc => SrcInitInputData%WaveAcc + DstInitInputData%WaveAccMCF => SrcInitInputData%WaveAccMCF + DstInitInputData%WaveVel => SrcInitInputData%WaveVel + DstInitInputData%PWaveDynP0 => SrcInitInputData%PWaveDynP0 + DstInitInputData%PWaveAcc0 => SrcInitInputData%PWaveAcc0 + DstInitInputData%PWaveAccMCF0 => SrcInitInputData%PWaveAccMCF0 + DstInitInputData%PWaveVel0 => SrcInitInputData%PWaveVel0 + DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 IF (ALLOCATED(SrcInitInputData%WaveElevC)) THEN i1_l = LBOUND(SrcInitInputData%WaveElevC,1) i1_u = UBOUND(SrcInitInputData%WaveElevC,1) @@ -2022,18 +1819,7 @@ SUBROUTINE HydroDyn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, END IF DstInitInputData%WaveElevC = SrcInitInputData%WaveElevC ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveDirArr)) THEN - i1_l = LBOUND(SrcInitInputData%WaveDirArr,1) - i1_u = UBOUND(SrcInitInputData%WaveDirArr,1) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveDirArr)) THEN - ALLOCATE(DstInitInputData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveDirArr = SrcInitInputData%WaveDirArr -ENDIF + DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax DstInitInputData%WaveDir = SrcInitInputData%WaveDir @@ -2048,14 +1834,12 @@ SUBROUTINE HydroDyn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE HydroDyn_CopyInitInput - SUBROUTINE HydroDyn_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE HydroDyn_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(HydroDyn_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyInitInput' @@ -2063,88 +1847,30 @@ SUBROUTINE HydroDyn_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedFileData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedFileData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ASSOCIATED(InitInputData%WaveElev1)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveElev1) - InitInputData%WaveElev1 => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%WaveElev2)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveElev2) - InitInputData%WaveElev2 => NULL() -ENDIF +NULLIFY(InitInputData%WaveElev1) +NULLIFY(InitInputData%WaveElev2) IF (ALLOCATED(InitInputData%WaveElev0)) THEN DEALLOCATE(InitInputData%WaveElev0) ENDIF -IF (ASSOCIATED(InitInputData%WaveTime)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveTime) - InitInputData%WaveTime => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%WaveDynP)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveDynP) - InitInputData%WaveDynP => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%WaveAcc)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveAcc) - InitInputData%WaveAcc => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%WaveAccMCF)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveAccMCF) - InitInputData%WaveAccMCF => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%WaveVel)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveVel) - InitInputData%WaveVel => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%PWaveDynP0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%PWaveDynP0) - InitInputData%PWaveDynP0 => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%PWaveAcc0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%PWaveAcc0) - InitInputData%PWaveAcc0 => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%PWaveAccMCF0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%PWaveAccMCF0) - InitInputData%PWaveAccMCF0 => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%PWaveVel0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%PWaveVel0) - InitInputData%PWaveVel0 => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%WaveElevC0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveElevC0) - InitInputData%WaveElevC0 => NULL() -ENDIF +NULLIFY(InitInputData%WaveTime) +NULLIFY(InitInputData%WaveDynP) +NULLIFY(InitInputData%WaveAcc) +NULLIFY(InitInputData%WaveAccMCF) +NULLIFY(InitInputData%WaveVel) +NULLIFY(InitInputData%PWaveDynP0) +NULLIFY(InitInputData%PWaveAcc0) +NULLIFY(InitInputData%PWaveAccMCF0) +NULLIFY(InitInputData%PWaveVel0) +NULLIFY(InitInputData%WaveElevC0) IF (ALLOCATED(InitInputData%WaveElevC)) THEN DEALLOCATE(InitInputData%WaveElevC) ENDIF -IF (ASSOCIATED(InitInputData%WaveDirArr)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveDirArr) - InitInputData%WaveDirArr => NULL() -ENDIF - CALL SeaSt_Interp_DestroyParam( InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +NULLIFY(InitInputData%WaveDirArr) + CALL SeaSt_Interp_DestroyParam( InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_WaveField_Destroyseast_wavefieldtype( InitInputData%WaveField, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_WaveField_DestroySeaSt_WaveFieldType( InitInputData%WaveField, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE HydroDyn_DestroyInitInput @@ -2187,7 +1913,7 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 1 ! UseInputFile ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! PassedFileData: size of buffers for each call to pack subtype - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2225,80 +1951,15 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_BufSz = Re_BufSz + 1 ! WvLowCOffS Re_BufSz = Re_BufSz + 1 ! WvHiCOffS Int_BufSz = Int_BufSz + 1 ! InvalidWithSSExctn - Int_BufSz = Int_BufSz + 1 ! WaveElev1 allocated yes/no - IF ( ASSOCIATED(InData%WaveElev1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElev1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev1) ! WaveElev1 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev2 allocated yes/no - IF ( ASSOCIATED(InData%WaveElev2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElev2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev2) ! WaveElev2 - END IF Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no IF ( ALLOCATED(InData%WaveElev0) ) THEN Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ASSOCIATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP allocated yes/no - IF ( ASSOCIATED(InData%WaveDynP) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! WaveDynP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP) ! WaveDynP - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc allocated yes/no - IF ( ASSOCIATED(InData%WaveAcc) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveAcc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc) ! WaveAcc - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAccMCF allocated yes/no - IF ( ASSOCIATED(InData%WaveAccMCF) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveAccMCF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAccMCF) ! WaveAccMCF - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel allocated yes/no - IF ( ASSOCIATED(InData%WaveVel) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel) ! WaveVel - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveDynP0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveDynP0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PWaveDynP0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveDynP0) ! PWaveDynP0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveAcc0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveAcc0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveAcc0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveAcc0) ! PWaveAcc0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveAccMCF0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveAccMCF0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveAccMCF0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveAccMCF0) ! PWaveAccMCF0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveVel0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveVel0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveVel0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveVel0) ! PWaveVel0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevC0 allocated yes/no - IF ( ASSOCIATED(InData%WaveElevC0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevC0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC0) ! WaveElevC0 - END IF Int_BufSz = Int_BufSz + 1 ! WaveElevC allocated yes/no IF ( ALLOCATED(InData%WaveElevC) ) THEN Int_BufSz = Int_BufSz + 2*3 ! WaveElevC upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC) ! WaveElevC - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDirArr allocated yes/no - IF ( ASSOCIATED(InData%WaveDirArr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveDirArr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDirArr) ! WaveDirArr END IF Re_BufSz = Re_BufSz + 1 ! WaveDirMin Re_BufSz = Re_BufSz + 1 ! WaveDirMax @@ -2324,7 +1985,7 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF Re_BufSz = Re_BufSz + 1 ! MCFD Int_BufSz = Int_BufSz + 3 ! WaveField: size of buffers for each call to pack subtype - CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField + CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2373,7 +2034,7 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END DO ! I IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2447,56 +2108,6 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_Xferred = Re_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%InvalidWithSSExctn, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ASSOCIATED(InData%WaveElev1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElev1,3), UBOUND(InData%WaveElev1,3) - DO i2 = LBOUND(InData%WaveElev1,2), UBOUND(InData%WaveElev1,2) - DO i1 = LBOUND(InData%WaveElev1,1), UBOUND(InData%WaveElev1,1) - ReKiBuf(Re_Xferred) = InData%WaveElev1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveElev2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElev2,3), UBOUND(InData%WaveElev2,3) - DO i2 = LBOUND(InData%WaveElev2,2), UBOUND(InData%WaveElev2,2) - DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) - ReKiBuf(Re_Xferred) = InData%WaveElev2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2512,400 +2123,100 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( .NOT. ASSOCIATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveDynP) ) THEN + IF ( .NOT. ALLOCATED(InData%WaveElevC) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,3) + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,2) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,4) + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,3) Int_Xferred = Int_Xferred + 2 - DO i4 = LBOUND(InData%WaveDynP,4), UBOUND(InData%WaveDynP,4) - DO i3 = LBOUND(InData%WaveDynP,3), UBOUND(InData%WaveDynP,3) - DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) - DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO + DO i3 = LBOUND(InData%WaveElevC,3), UBOUND(InData%WaveElevC,3) + DO i2 = LBOUND(InData%WaveElevC,2), UBOUND(InData%WaveElevC,2) + DO i1 = LBOUND(InData%WaveElevC,1), UBOUND(InData%WaveElevC,1) + ReKiBuf(Re_Xferred) = InData%WaveElevC(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 END DO END DO END DO END IF - IF ( .NOT. ASSOCIATED(InData%WaveAcc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 + ReKiBuf(Re_Xferred) = InData%WaveDirMin + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirMax + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,5) - Int_Xferred = Int_Xferred + 2 + ReKiBuf(Re_Xferred) = InData%WaveDOmega + Re_Xferred = Re_Xferred + 1 + CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - DO i5 = LBOUND(InData%WaveAcc,5), UBOUND(InData%WaveAcc,5) - DO i4 = LBOUND(InData%WaveAcc,4), UBOUND(InData%WaveAcc,4) - DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) - DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) - DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveAccMCF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,5) - Int_Xferred = Int_Xferred + 2 + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + ReKiBuf(Re_Xferred) = InData%MCFD + Re_Xferred = Re_Xferred + 1 + CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - DO i5 = LBOUND(InData%WaveAccMCF,5), UBOUND(InData%WaveAccMCF,5) - DO i4 = LBOUND(InData%WaveAccMCF,4), UBOUND(InData%WaveAccMCF,4) - DO i3 = LBOUND(InData%WaveAccMCF,3), UBOUND(InData%WaveAccMCF,3) - DO i2 = LBOUND(InData%WaveAccMCF,2), UBOUND(InData%WaveAccMCF,2) - DO i1 = LBOUND(InData%WaveAccMCF,1), UBOUND(InData%WaveAccMCF,1) - ReKiBuf(Re_Xferred) = InData%WaveAccMCF(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveVel,5), UBOUND(InData%WaveVel,5) - DO i4 = LBOUND(InData%WaveVel,4), UBOUND(InData%WaveVel,4) - DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) - DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) - DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) - ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveDynP0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PWaveDynP0,3), UBOUND(InData%PWaveDynP0,3) - DO i2 = LBOUND(InData%PWaveDynP0,2), UBOUND(InData%PWaveDynP0,2) - DO i1 = LBOUND(InData%PWaveDynP0,1), UBOUND(InData%PWaveDynP0,1) - ReKiBuf(Re_Xferred) = InData%PWaveDynP0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveAcc0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveAcc0,4), UBOUND(InData%PWaveAcc0,4) - DO i3 = LBOUND(InData%PWaveAcc0,3), UBOUND(InData%PWaveAcc0,3) - DO i2 = LBOUND(InData%PWaveAcc0,2), UBOUND(InData%PWaveAcc0,2) - DO i1 = LBOUND(InData%PWaveAcc0,1), UBOUND(InData%PWaveAcc0,1) - ReKiBuf(Re_Xferred) = InData%PWaveAcc0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveAccMCF0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveAccMCF0,4), UBOUND(InData%PWaveAccMCF0,4) - DO i3 = LBOUND(InData%PWaveAccMCF0,3), UBOUND(InData%PWaveAccMCF0,3) - DO i2 = LBOUND(InData%PWaveAccMCF0,2), UBOUND(InData%PWaveAccMCF0,2) - DO i1 = LBOUND(InData%PWaveAccMCF0,1), UBOUND(InData%PWaveAccMCF0,1) - ReKiBuf(Re_Xferred) = InData%PWaveAccMCF0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveVel0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveVel0,4), UBOUND(InData%PWaveVel0,4) - DO i3 = LBOUND(InData%PWaveVel0,3), UBOUND(InData%PWaveVel0,3) - DO i2 = LBOUND(InData%PWaveVel0,2), UBOUND(InData%PWaveVel0,2) - DO i1 = LBOUND(InData%PWaveVel0,1), UBOUND(InData%PWaveVel0,1) - ReKiBuf(Re_Xferred) = InData%PWaveVel0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveElevC0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) - DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElevC,3), UBOUND(InData%WaveElevC,3) - DO i2 = LBOUND(InData%WaveElevC,2), UBOUND(InData%WaveElevC,2) - DO i1 = LBOUND(InData%WaveElevC,1), UBOUND(InData%WaveElevC,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveDirArr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDirArr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) - ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - ReKiBuf(Re_Xferred) = InData%MCFD - Re_Xferred = Re_Xferred + 1 - CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE HydroDyn_PackInitInput + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE HydroDyn_PackInitInput SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) @@ -2920,505 +2231,146 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackfileinfotype( Re_Buf, Db_Buf, Int_Buf, OutData%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%PtfmLocationX = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmLocationY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RhoXg = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveStMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDirMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WvLowCOff = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOff = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%InvalidWithSSExctn = TRANSFER(IntKiBuf(Int_Xferred), OutData%InvalidWithSSExctn) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElev1)) DEALLOCATE(OutData%WaveElev1) - ALLOCATE(OutData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElev1,3), UBOUND(OutData%WaveElev1,3) - DO i2 = LBOUND(OutData%WaveElev1,2), UBOUND(OutData%WaveElev1,2) - DO i1 = LBOUND(OutData%WaveElev1,1), UBOUND(OutData%WaveElev1,1) - OutData%WaveElev1(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElev2)) DEALLOCATE(OutData%WaveElev2) - ALLOCATE(OutData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElev2,3), UBOUND(OutData%WaveElev2,3) - DO i2 = LBOUND(OutData%WaveElev2,2), UBOUND(OutData%WaveElev2,2) - DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) - OutData%WaveElev2(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev0)) DEALLOCATE(OutData%WaveElev0) - ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) - OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveDynP)) DEALLOCATE(OutData%WaveDynP) - ALLOCATE(OutData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%WaveDynP,4), UBOUND(OutData%WaveDynP,4) - DO i3 = LBOUND(OutData%WaveDynP,3), UBOUND(OutData%WaveDynP,3) - DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) - DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) - OutData%WaveDynP(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveAcc)) DEALLOCATE(OutData%WaveAcc) - ALLOCATE(OutData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAcc,5), UBOUND(OutData%WaveAcc,5) - DO i4 = LBOUND(OutData%WaveAcc,4), UBOUND(OutData%WaveAcc,4) - DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) - DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) - DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) - OutData%WaveAcc(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAccMCF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveAccMCF)) DEALLOCATE(OutData%WaveAccMCF) - ALLOCATE(OutData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAccMCF,5), UBOUND(OutData%WaveAccMCF,5) - DO i4 = LBOUND(OutData%WaveAccMCF,4), UBOUND(OutData%WaveAccMCF,4) - DO i3 = LBOUND(OutData%WaveAccMCF,3), UBOUND(OutData%WaveAccMCF,3) - DO i2 = LBOUND(OutData%WaveAccMCF,2), UBOUND(OutData%WaveAccMCF,2) - DO i1 = LBOUND(OutData%WaveAccMCF,1), UBOUND(OutData%WaveAccMCF,1) - OutData%WaveAccMCF(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveVel)) DEALLOCATE(OutData%WaveVel) - ALLOCATE(OutData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveVel,5), UBOUND(OutData%WaveVel,5) - DO i4 = LBOUND(OutData%WaveVel,4), UBOUND(OutData%WaveVel,4) - DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) - DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) - DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) - OutData%WaveVel(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveDynP0 not allocated + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackInitInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) Int_Xferred = Int_Xferred + 1 - ELSE + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + DO I = 1, LEN(OutData%OutRootName) + OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveDynP0)) DEALLOCATE(OutData%PWaveDynP0) - ALLOCATE(OutData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PWaveDynP0,3), UBOUND(OutData%PWaveDynP0,3) - DO i2 = LBOUND(OutData%PWaveDynP0,2), UBOUND(OutData%PWaveDynP0,2) - DO i1 = LBOUND(OutData%PWaveDynP0,1), UBOUND(OutData%PWaveDynP0,1) - OutData%PWaveDynP0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAcc0 not allocated + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%PtfmLocationX = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmLocationY = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - ELSE + OutData%NStepWave2 = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveAcc0)) DEALLOCATE(OutData%PWaveAcc0) - ALLOCATE(OutData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveAcc0,4), UBOUND(OutData%PWaveAcc0,4) - DO i3 = LBOUND(OutData%PWaveAcc0,3), UBOUND(OutData%PWaveAcc0,3) - DO i2 = LBOUND(OutData%PWaveAcc0,2), UBOUND(OutData%PWaveAcc0,2) - DO i1 = LBOUND(OutData%PWaveAcc0,1), UBOUND(OutData%PWaveAcc0,1) - OutData%PWaveAcc0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAccMCF0 not allocated + OutData%RhoXg = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveMod = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - ELSE + OutData%WaveStMod = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveAccMCF0)) DEALLOCATE(OutData%PWaveAccMCF0) - ALLOCATE(OutData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveAccMCF0,4), UBOUND(OutData%PWaveAccMCF0,4) - DO i3 = LBOUND(OutData%PWaveAccMCF0,3), UBOUND(OutData%PWaveAccMCF0,3) - DO i2 = LBOUND(OutData%PWaveAccMCF0,2), UBOUND(OutData%PWaveAccMCF0,2) - DO i1 = LBOUND(OutData%PWaveAccMCF0,1), UBOUND(OutData%PWaveAccMCF0,1) - OutData%PWaveAccMCF0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveVel0 not allocated + OutData%WaveDirMod = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - ELSE + OutData%WvLowCOff = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOff = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvLowCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvLowCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%InvalidWithSSExctn = TRANSFER(IntKiBuf(Int_Xferred), OutData%InvalidWithSSExctn) Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveVel0)) DEALLOCATE(OutData%PWaveVel0) - ALLOCATE(OutData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveVel0,4), UBOUND(OutData%PWaveVel0,4) - DO i3 = LBOUND(OutData%PWaveVel0,3), UBOUND(OutData%PWaveVel0,3) - DO i2 = LBOUND(OutData%PWaveVel0,2), UBOUND(OutData%PWaveVel0,2) - DO i1 = LBOUND(OutData%PWaveVel0,1), UBOUND(OutData%PWaveVel0,1) - OutData%PWaveVel0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated + NULLIFY(OutData%WaveElev1) + NULLIFY(OutData%WaveElev2) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElevC0)) DEALLOCATE(OutData%WaveElevC0) - ALLOCATE(OutData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%WaveElev0)) DEALLOCATE(OutData%WaveElev0) + ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) - DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) - OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO + DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) + OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END DO END IF + NULLIFY(OutData%WaveTime) + NULLIFY(OutData%WaveDynP) + NULLIFY(OutData%WaveAcc) + NULLIFY(OutData%WaveAccMCF) + NULLIFY(OutData%WaveVel) + NULLIFY(OutData%PWaveDynP0) + NULLIFY(OutData%PWaveAcc0) + NULLIFY(OutData%PWaveAccMCF0) + NULLIFY(OutData%PWaveVel0) + NULLIFY(OutData%WaveElevC0) IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3447,24 +2399,7 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveDirArr)) DEALLOCATE(OutData%WaveDirArr) - ALLOCATE(OutData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) - OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF + NULLIFY(OutData%WaveDirArr) OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) Re_Xferred = Re_Xferred + 1 OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) @@ -3550,7 +2485,7 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SeaSt_WaveField_Unpackseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField + CALL SeaSt_WaveField_UnpackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3666,14 +2601,12 @@ SUBROUTINE HydroDyn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCo ENDIF END SUBROUTINE HydroDyn_CopyInitOutput - SUBROUTINE HydroDyn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE HydroDyn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(HydroDyn_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyInitOutput' @@ -3681,13 +2614,7 @@ SUBROUTINE HydroDyn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL Morison_DestroyInitOutput( InitOutputData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyInitOutput( InitOutputData%Morison, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) @@ -3695,7 +2622,7 @@ SUBROUTINE HydroDyn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCA IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN DEALLOCATE(InitOutputData%WriteOutputUnt) ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitOutputData%LinNames_y)) THEN DEALLOCATE(InitOutputData%LinNames_y) @@ -3778,7 +2705,7 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt END IF Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3908,7 +2835,7 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END DO ! I END DO END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4159,7 +3086,7 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4289,14 +3216,12 @@ SUBROUTINE HydroDyn_CopyHD_ModuleMapType( SrcHD_ModuleMapTypeData, DstHD_ModuleM IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE HydroDyn_CopyHD_ModuleMapType - SUBROUTINE HydroDyn_DestroyHD_ModuleMapType( HD_ModuleMapTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE HydroDyn_DestroyHD_ModuleMapType( HD_ModuleMapTypeData, ErrStat, ErrMsg ) TYPE(HD_ModuleMapType), INTENT(INOUT) :: HD_ModuleMapTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyHD_ModuleMapType' @@ -4304,17 +3229,11 @@ SUBROUTINE HydroDyn_DestroyHD_ModuleMapType( HD_ModuleMapTypeData, ErrStat, ErrM ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroymeshmaptype( HD_ModuleMapTypeData%uW_P_2_PRP_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( HD_ModuleMapTypeData%uW_P_2_PRP_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( HD_ModuleMapTypeData%W_P_2_PRP_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( HD_ModuleMapTypeData%W_P_2_PRP_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( HD_ModuleMapTypeData%M_P_2_PRP_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( HD_ModuleMapTypeData%M_P_2_PRP_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE HydroDyn_DestroyHD_ModuleMapType @@ -4355,7 +3274,7 @@ SUBROUTINE HydroDyn_PackHD_ModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! uW_P_2_PRP_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%uW_P_2_PRP_P, ErrStat2, ErrMsg2, .TRUE. ) ! uW_P_2_PRP_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%uW_P_2_PRP_P, ErrStat2, ErrMsg2, .TRUE. ) ! uW_P_2_PRP_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4372,7 +3291,7 @@ SUBROUTINE HydroDyn_PackHD_ModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! W_P_2_PRP_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%W_P_2_PRP_P, ErrStat2, ErrMsg2, .TRUE. ) ! W_P_2_PRP_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%W_P_2_PRP_P, ErrStat2, ErrMsg2, .TRUE. ) ! W_P_2_PRP_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4389,7 +3308,7 @@ SUBROUTINE HydroDyn_PackHD_ModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! M_P_2_PRP_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%M_P_2_PRP_P, ErrStat2, ErrMsg2, .TRUE. ) ! M_P_2_PRP_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%M_P_2_PRP_P, ErrStat2, ErrMsg2, .TRUE. ) ! M_P_2_PRP_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4432,7 +3351,7 @@ SUBROUTINE HydroDyn_PackHD_ModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er Db_Xferred = 1 Int_Xferred = 1 - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%uW_P_2_PRP_P, ErrStat2, ErrMsg2, OnlySize ) ! uW_P_2_PRP_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%uW_P_2_PRP_P, ErrStat2, ErrMsg2, OnlySize ) ! uW_P_2_PRP_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4460,7 +3379,7 @@ SUBROUTINE HydroDyn_PackHD_ModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%W_P_2_PRP_P, ErrStat2, ErrMsg2, OnlySize ) ! W_P_2_PRP_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%W_P_2_PRP_P, ErrStat2, ErrMsg2, OnlySize ) ! W_P_2_PRP_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4488,7 +3407,7 @@ SUBROUTINE HydroDyn_PackHD_ModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%M_P_2_PRP_P, ErrStat2, ErrMsg2, OnlySize ) ! M_P_2_PRP_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%M_P_2_PRP_P, ErrStat2, ErrMsg2, OnlySize ) ! M_P_2_PRP_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4577,7 +3496,7 @@ SUBROUTINE HydroDyn_UnPackHD_ModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%uW_P_2_PRP_P, ErrStat2, ErrMsg2 ) ! uW_P_2_PRP_P + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%uW_P_2_PRP_P, ErrStat2, ErrMsg2 ) ! uW_P_2_PRP_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4617,7 +3536,7 @@ SUBROUTINE HydroDyn_UnPackHD_ModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%W_P_2_PRP_P, ErrStat2, ErrMsg2 ) ! W_P_2_PRP_P + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%W_P_2_PRP_P, ErrStat2, ErrMsg2 ) ! W_P_2_PRP_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4657,7 +3576,7 @@ SUBROUTINE HydroDyn_UnPackHD_ModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%M_P_2_PRP_P, ErrStat2, ErrMsg2 ) ! M_P_2_PRP_P + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%M_P_2_PRP_P, ErrStat2, ErrMsg2 ) ! M_P_2_PRP_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4702,14 +3621,12 @@ SUBROUTINE HydroDyn_CopyContState( SrcContStateData, DstContStateData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE HydroDyn_CopyContState - SUBROUTINE HydroDyn_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE HydroDyn_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(HydroDyn_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyContState' @@ -4717,20 +3634,14 @@ SUBROUTINE HydroDyn_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ContStateData%WAMIT)) THEN DO i1 = LBOUND(ContStateData%WAMIT,1), UBOUND(ContStateData%WAMIT,1) - CALL WAMIT_DestroyContState( ContStateData%WAMIT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WAMIT_DestroyContState( ContStateData%WAMIT(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ContStateData%WAMIT) ENDIF - CALL Morison_DestroyContState( ContStateData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyContState( ContStateData%Morison, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE HydroDyn_DestroyContState @@ -5069,14 +3980,12 @@ SUBROUTINE HydroDyn_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE HydroDyn_CopyDiscState - SUBROUTINE HydroDyn_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE HydroDyn_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(HydroDyn_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyDiscState' @@ -5084,20 +3993,14 @@ SUBROUTINE HydroDyn_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(DiscStateData%WAMIT)) THEN DO i1 = LBOUND(DiscStateData%WAMIT,1), UBOUND(DiscStateData%WAMIT,1) - CALL WAMIT_DestroyDiscState( DiscStateData%WAMIT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WAMIT_DestroyDiscState( DiscStateData%WAMIT(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(DiscStateData%WAMIT) ENDIF - CALL Morison_DestroyDiscState( DiscStateData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyDiscState( DiscStateData%Morison, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE HydroDyn_DestroyDiscState @@ -5422,14 +4325,12 @@ SUBROUTINE HydroDyn_CopyConstrState( SrcConstrStateData, DstConstrStateData, Ctr IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE HydroDyn_CopyConstrState - SUBROUTINE HydroDyn_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE HydroDyn_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(HydroDyn_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyConstrState' @@ -5437,15 +4338,9 @@ SUBROUTINE HydroDyn_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL WAMIT_DestroyConstrState( ConstrStateData%WAMIT, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WAMIT_DestroyConstrState( ConstrStateData%WAMIT, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Morison_DestroyConstrState( ConstrStateData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyConstrState( ConstrStateData%Morison, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE HydroDyn_DestroyConstrState @@ -5748,14 +4643,12 @@ SUBROUTINE HydroDyn_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCo IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE HydroDyn_CopyOtherState - SUBROUTINE HydroDyn_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE HydroDyn_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(HydroDyn_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyOtherState' @@ -5763,20 +4656,14 @@ SUBROUTINE HydroDyn_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OtherStateData%WAMIT)) THEN DO i1 = LBOUND(OtherStateData%WAMIT,1), UBOUND(OtherStateData%WAMIT,1) - CALL WAMIT_DestroyOtherState( OtherStateData%WAMIT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WAMIT_DestroyOtherState( OtherStateData%WAMIT(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OtherStateData%WAMIT) ENDIF - CALL Morison_DestroyOtherState( OtherStateData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyOtherState( OtherStateData%Morison, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE HydroDyn_DestroyOtherState @@ -6181,14 +5068,12 @@ SUBROUTINE HydroDyn_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMs ENDIF END SUBROUTINE HydroDyn_CopyMisc - SUBROUTINE HydroDyn_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE HydroDyn_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyMisc' @@ -6196,15 +5081,9 @@ SUBROUTINE HydroDyn_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( MiscData%AllHdroOrigin, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_Destroyhd_modulemaptype( MiscData%HD_MeshMap, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL HydroDyn_DestroyHD_ModuleMapType( MiscData%HD_MeshMap, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MiscData%F_PtfmAdd)) THEN DEALLOCATE(MiscData%F_PtfmAdd) @@ -6214,23 +5093,23 @@ SUBROUTINE HydroDyn_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(MiscData%WAMIT)) THEN DO i1 = LBOUND(MiscData%WAMIT,1), UBOUND(MiscData%WAMIT,1) - CALL WAMIT_DestroyMisc( MiscData%WAMIT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WAMIT_DestroyMisc( MiscData%WAMIT(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%WAMIT) ENDIF IF (ALLOCATED(MiscData%WAMIT2)) THEN DO i1 = LBOUND(MiscData%WAMIT2,1), UBOUND(MiscData%WAMIT2,1) - CALL WAMIT2_DestroyMisc( MiscData%WAMIT2(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WAMIT2_DestroyMisc( MiscData%WAMIT2(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%WAMIT2) ENDIF - CALL Morison_DestroyMisc( MiscData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyMisc( MiscData%Morison, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MiscData%u_WAMIT)) THEN DO i1 = LBOUND(MiscData%u_WAMIT,1), UBOUND(MiscData%u_WAMIT,1) - CALL WAMIT_DestroyInput( MiscData%u_WAMIT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WAMIT_DestroyInput( MiscData%u_WAMIT(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%u_WAMIT) @@ -6291,7 +5170,7 @@ SUBROUTINE HydroDyn_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! HD_MeshMap: size of buffers for each call to pack subtype - CALL HydroDyn_Packhd_modulemaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_MeshMap, ErrStat2, ErrMsg2, .TRUE. ) ! HD_MeshMap + CALL HydroDyn_PackHD_ModuleMapType( Re_Buf, Db_Buf, Int_Buf, InData%HD_MeshMap, ErrStat2, ErrMsg2, .TRUE. ) ! HD_MeshMap CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6462,7 +5341,7 @@ SUBROUTINE HydroDyn_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL HydroDyn_Packhd_modulemaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_MeshMap, ErrStat2, ErrMsg2, OnlySize ) ! HD_MeshMap + CALL HydroDyn_PackHD_ModuleMapType( Re_Buf, Db_Buf, Int_Buf, InData%HD_MeshMap, ErrStat2, ErrMsg2, OnlySize ) ! HD_MeshMap CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6783,7 +5662,7 @@ SUBROUTINE HydroDyn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL HydroDyn_Unpackhd_modulemaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_MeshMap, ErrStat2, ErrMsg2 ) ! HD_MeshMap + CALL HydroDyn_UnpackHD_ModuleMapType( Re_Buf, Db_Buf, Int_Buf, OutData%HD_MeshMap, ErrStat2, ErrMsg2 ) ! HD_MeshMap CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7109,18 +5988,7 @@ SUBROUTINE HydroDyn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Er DstParamData%totalStates = SrcParamData%totalStates DstParamData%totalExctnStates = SrcParamData%totalExctnStates DstParamData%totalRdtnStates = SrcParamData%totalRdtnStates -IF (ASSOCIATED(SrcParamData%WaveTime)) THEN - i1_l = LBOUND(SrcParamData%WaveTime,1) - i1_u = UBOUND(SrcParamData%WaveTime,1) - IF (.NOT. ASSOCIATED(DstParamData%WaveTime)) THEN - ALLOCATE(DstParamData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveTime = SrcParamData%WaveTime -ENDIF + DstParamData%WaveTime => SrcParamData%WaveTime DstParamData%NStepWave = SrcParamData%NStepWave DstParamData%WtrDpth = SrcParamData%WtrDpth IF (ALLOCATED(SrcParamData%AddF0)) THEN @@ -7252,14 +6120,12 @@ SUBROUTINE HydroDyn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Er DstParamData%PointsToSeaState = SrcParamData%PointsToSeaState END SUBROUTINE HydroDyn_CopyParam - SUBROUTINE HydroDyn_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE HydroDyn_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(HydroDyn_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyParam' @@ -7267,33 +6133,23 @@ SUBROUTINE HydroDyn_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%WAMIT)) THEN DO i1 = LBOUND(ParamData%WAMIT,1), UBOUND(ParamData%WAMIT,1) - CALL WAMIT_DestroyParam( ParamData%WAMIT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WAMIT_DestroyParam( ParamData%WAMIT(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%WAMIT) ENDIF IF (ALLOCATED(ParamData%WAMIT2)) THEN DO i1 = LBOUND(ParamData%WAMIT2,1), UBOUND(ParamData%WAMIT2,1) - CALL WAMIT2_DestroyParam( ParamData%WAMIT2(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WAMIT2_DestroyParam( ParamData%WAMIT2(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%WAMIT2) ENDIF - CALL Morison_DestroyParam( ParamData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyParam( ParamData%Morison, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ASSOCIATED(ParamData%WaveTime)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%WaveTime) - ParamData%WaveTime => NULL() -ENDIF +NULLIFY(ParamData%WaveTime) IF (ALLOCATED(ParamData%AddF0)) THEN DEALLOCATE(ParamData%AddF0) ENDIF @@ -7308,7 +6164,7 @@ SUBROUTINE HydroDyn_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) @@ -7432,11 +6288,6 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_BufSz = Int_BufSz + 1 ! totalStates Int_BufSz = Int_BufSz + 1 ! totalExctnStates Int_BufSz = Int_BufSz + 1 ! totalRdtnStates - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ASSOCIATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF Int_BufSz = Int_BufSz + 1 ! NStepWave Re_BufSz = Re_BufSz + 1 ! WtrDpth Int_BufSz = Int_BufSz + 1 ! AddF0 allocated yes/no @@ -7465,7 +6316,7 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7663,21 +6514,6 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%totalRdtnStates Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ASSOCIATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF IntKiBuf(Int_Xferred) = InData%NStepWave Int_Xferred = Int_Xferred + 1 ReKiBuf(Re_Xferred) = InData%WtrDpth @@ -7790,7 +6626,7 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8097,24 +6933,7 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Int_Xferred = Int_Xferred + 1 OutData%totalRdtnStates = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF + NULLIFY(OutData%WaveTime) OutData%NStepWave = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%WtrDpth = ReKiBuf(Re_Xferred) @@ -8275,7 +7094,7 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8396,14 +7215,12 @@ SUBROUTINE HydroDyn_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, Er IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE HydroDyn_CopyInput - SUBROUTINE HydroDyn_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE HydroDyn_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(HydroDyn_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyInput' @@ -8411,13 +7228,7 @@ SUBROUTINE HydroDyn_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL Morison_DestroyInput( InputData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyInput( InputData%Morison, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL MeshDestroy( InputData%WAMITMesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8840,14 +7651,12 @@ SUBROUTINE HydroDyn_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ENDIF END SUBROUTINE HydroDyn_CopyOutput - SUBROUTINE HydroDyn_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE HydroDyn_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(HydroDyn_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyOutput' @@ -8855,27 +7664,21 @@ SUBROUTINE HydroDyn_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%WAMIT)) THEN DO i1 = LBOUND(OutputData%WAMIT,1), UBOUND(OutputData%WAMIT,1) - CALL WAMIT_DestroyOutput( OutputData%WAMIT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WAMIT_DestroyOutput( OutputData%WAMIT(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OutputData%WAMIT) ENDIF IF (ALLOCATED(OutputData%WAMIT2)) THEN DO i1 = LBOUND(OutputData%WAMIT2,1), UBOUND(OutputData%WAMIT2,1) - CALL WAMIT2_DestroyOutput( OutputData%WAMIT2(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WAMIT2_DestroyOutput( OutputData%WAMIT2(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OutputData%WAMIT2) ENDIF - CALL Morison_DestroyOutput( OutputData%Morison, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyOutput( OutputData%Morison, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL MeshDestroy( OutputData%WAMITMesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 35ee937376..9a8f65bb4f 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -31,6 +31,7 @@ !! 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 @@ -331,7 +332,7 @@ MODULE Morison_Types TYPE(Morison_MOutput) , DIMENSION(:), ALLOCATABLE :: MOutLst !< [-] INTEGER(IntKi) :: NJOutputs !< [-] TYPE(Morison_JOutput) , DIMENSION(:), ALLOCATABLE :: JOutLst !< [-] - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< This list size needs to be the maximum of possible outputs because of the use of ReadAry(). Use MaxMrsnOutputs [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< This list size needs to be the maximum # of possible outputs because of the use of ReadAry(). Use MaxMrsnOutputs [-] INTEGER(IntKi) :: NumOuts !< [-] INTEGER(IntKi) :: UnSum !< [-] INTEGER(IntKi) :: NStepWave !< [-] @@ -473,10 +474,6 @@ SUBROUTINE Morison_CopyJointType( SrcJointTypeData, DstJointTypeData, CtrlCode, ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyJointType' @@ -492,14 +489,12 @@ SUBROUTINE Morison_CopyJointType( SrcJointTypeData, DstJointTypeData, CtrlCode, DstJointTypeData%ConnectionList = SrcJointTypeData%ConnectionList END SUBROUTINE Morison_CopyJointType - SUBROUTINE Morison_DestroyJointType( JointTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyJointType( JointTypeData, ErrStat, ErrMsg ) TYPE(Morison_JointType), INTENT(INOUT) :: JointTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyJointType' @@ -507,12 +502,6 @@ SUBROUTINE Morison_DestroyJointType( JointTypeData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Morison_DestroyJointType SUBROUTINE Morison_PackJointType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -618,10 +607,6 @@ SUBROUTINE Morison_UnPackJointType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackJointType' @@ -678,14 +663,12 @@ SUBROUTINE Morison_CopyMemberPropType( SrcMemberPropTypeData, DstMemberPropTypeD DstMemberPropTypeData%PropThck = SrcMemberPropTypeData%PropThck END SUBROUTINE Morison_CopyMemberPropType - SUBROUTINE Morison_DestroyMemberPropType( MemberPropTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyMemberPropType( MemberPropTypeData, ErrStat, ErrMsg ) TYPE(Morison_MemberPropType), INTENT(INOUT) :: MemberPropTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMemberPropType' @@ -693,12 +676,6 @@ SUBROUTINE Morison_DestroyMemberPropType( MemberPropTypeData, ErrStat, ErrMsg, D ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Morison_DestroyMemberPropType SUBROUTINE Morison_PackMemberPropType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -841,14 +818,12 @@ SUBROUTINE Morison_CopyFilledGroupType( SrcFilledGroupTypeData, DstFilledGroupTy DstFilledGroupTypeData%FillDens = SrcFilledGroupTypeData%FillDens END SUBROUTINE Morison_CopyFilledGroupType - SUBROUTINE Morison_DestroyFilledGroupType( FilledGroupTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyFilledGroupType( FilledGroupTypeData, ErrStat, ErrMsg ) TYPE(Morison_FilledGroupType), INTENT(INOUT) :: FilledGroupTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyFilledGroupType' @@ -856,12 +831,6 @@ SUBROUTINE Morison_DestroyFilledGroupType( FilledGroupTypeData, ErrStat, ErrMsg, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(FilledGroupTypeData%FillMList)) THEN DEALLOCATE(FilledGroupTypeData%FillMList) ENDIF @@ -1054,14 +1023,12 @@ SUBROUTINE Morison_CopyCoefDpths( SrcCoefDpthsData, DstCoefDpthsData, CtrlCode, DstCoefDpthsData%DpthMCF = SrcCoefDpthsData%DpthMCF END SUBROUTINE Morison_CopyCoefDpths - SUBROUTINE Morison_DestroyCoefDpths( CoefDpthsData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyCoefDpths( CoefDpthsData, ErrStat, ErrMsg ) TYPE(Morison_CoefDpths), INTENT(INOUT) :: CoefDpthsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyCoefDpths' @@ -1069,12 +1036,6 @@ SUBROUTINE Morison_DestroyCoefDpths( CoefDpthsData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Morison_DestroyCoefDpths SUBROUTINE Morison_PackCoefDpths( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1272,14 +1233,12 @@ SUBROUTINE Morison_CopyAxialCoefType( SrcAxialCoefTypeData, DstAxialCoefTypeData DstAxialCoefTypeData%AxFDMod = SrcAxialCoefTypeData%AxFDMod END SUBROUTINE Morison_CopyAxialCoefType - SUBROUTINE Morison_DestroyAxialCoefType( AxialCoefTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyAxialCoefType( AxialCoefTypeData, ErrStat, ErrMsg ) TYPE(Morison_AxialCoefType), INTENT(INOUT) :: AxialCoefTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyAxialCoefType' @@ -1287,12 +1246,6 @@ SUBROUTINE Morison_DestroyAxialCoefType( AxialCoefTypeData, ErrStat, ErrMsg, DEA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Morison_DestroyAxialCoefType SUBROUTINE Morison_PackAxialCoefType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1470,14 +1423,12 @@ SUBROUTINE Morison_CopyMemberInputType( SrcMemberInputTypeData, DstMemberInputTy DstMemberInputTypeData%dl = SrcMemberInputTypeData%dl END SUBROUTINE Morison_CopyMemberInputType - SUBROUTINE Morison_DestroyMemberInputType( MemberInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyMemberInputType( MemberInputTypeData, ErrStat, ErrMsg ) TYPE(Morison_MemberInputType), INTENT(INOUT) :: MemberInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMemberInputType' @@ -1485,12 +1436,6 @@ SUBROUTINE Morison_DestroyMemberInputType( MemberInputTypeData, ErrStat, ErrMsg, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MemberInputTypeData%NodeIndx)) THEN DEALLOCATE(MemberInputTypeData%NodeIndx) ENDIF @@ -1754,14 +1699,12 @@ SUBROUTINE Morison_CopyNodeType( SrcNodeTypeData, DstNodeTypeData, CtrlCode, Err DstNodeTypeData%MGdensity = SrcNodeTypeData%MGdensity END SUBROUTINE Morison_CopyNodeType - SUBROUTINE Morison_DestroyNodeType( NodeTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyNodeType( NodeTypeData, ErrStat, ErrMsg ) TYPE(Morison_NodeType), INTENT(INOUT) :: NodeTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyNodeType' @@ -1769,12 +1712,6 @@ SUBROUTINE Morison_DestroyNodeType( NodeTypeData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Morison_DestroyNodeType SUBROUTINE Morison_PackNodeType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2485,14 +2422,12 @@ SUBROUTINE Morison_CopyMemberType( SrcMemberTypeData, DstMemberTypeData, CtrlCod DstMemberTypeData%Flipped = SrcMemberTypeData%Flipped END SUBROUTINE Morison_CopyMemberType - SUBROUTINE Morison_DestroyMemberType( MemberTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyMemberType( MemberTypeData, ErrStat, ErrMsg ) TYPE(Morison_MemberType), INTENT(INOUT) :: MemberTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMemberType' @@ -2500,12 +2435,6 @@ SUBROUTINE Morison_DestroyMemberType( MemberTypeData, ErrStat, ErrMsg, DEALLOCAT ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MemberTypeData%NodeIndx)) THEN DEALLOCATE(MemberTypeData%NodeIndx) ENDIF @@ -4594,14 +4523,12 @@ SUBROUTINE Morison_CopyMemberLoads( SrcMemberLoadsData, DstMemberLoadsData, Ctrl ENDIF END SUBROUTINE Morison_CopyMemberLoads - SUBROUTINE Morison_DestroyMemberLoads( MemberLoadsData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyMemberLoads( MemberLoadsData, ErrStat, ErrMsg ) TYPE(Morison_MemberLoads), INTENT(INOUT) :: MemberLoadsData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMemberLoads' @@ -4609,12 +4536,6 @@ SUBROUTINE Morison_DestroyMemberLoads( MemberLoadsData, ErrStat, ErrMsg, DEALLOC ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MemberLoadsData%F_D)) THEN DEALLOCATE(MemberLoadsData%F_D) ENDIF @@ -5318,14 +5239,12 @@ SUBROUTINE Morison_CopyCoefMembers( SrcCoefMembersData, DstCoefMembersData, Ctrl DstCoefMembersData%MemberMCF = SrcCoefMembersData%MemberMCF END SUBROUTINE Morison_CopyCoefMembers - SUBROUTINE Morison_DestroyCoefMembers( CoefMembersData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyCoefMembers( CoefMembersData, ErrStat, ErrMsg ) TYPE(Morison_CoefMembers), INTENT(INOUT) :: CoefMembersData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyCoefMembers' @@ -5333,12 +5252,6 @@ SUBROUTINE Morison_DestroyCoefMembers( CoefMembersData, ErrStat, ErrMsg, DEALLOC ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Morison_DestroyCoefMembers SUBROUTINE Morison_PackCoefMembers( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -5602,14 +5515,12 @@ SUBROUTINE Morison_CopyMGDepthsType( SrcMGDepthsTypeData, DstMGDepthsTypeData, C DstMGDepthsTypeData%MGDens = SrcMGDepthsTypeData%MGDens END SUBROUTINE Morison_CopyMGDepthsType - SUBROUTINE Morison_DestroyMGDepthsType( MGDepthsTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyMGDepthsType( MGDepthsTypeData, ErrStat, ErrMsg ) TYPE(Morison_MGDepthsType), INTENT(INOUT) :: MGDepthsTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMGDepthsType' @@ -5617,12 +5528,6 @@ SUBROUTINE Morison_DestroyMGDepthsType( MGDepthsTypeData, ErrStat, ErrMsg, DEALL ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Morison_DestroyMGDepthsType SUBROUTINE Morison_PackMGDepthsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -5824,14 +5729,12 @@ SUBROUTINE Morison_CopyMOutput( SrcMOutputData, DstMOutputData, CtrlCode, ErrSta ENDIF END SUBROUTINE Morison_CopyMOutput - SUBROUTINE Morison_DestroyMOutput( MOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyMOutput( MOutputData, ErrStat, ErrMsg ) TYPE(Morison_MOutput), INTENT(INOUT) :: MOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMOutput' @@ -5839,12 +5742,6 @@ SUBROUTINE Morison_DestroyMOutput( MOutputData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MOutputData%NodeLocs)) THEN DEALLOCATE(MOutputData%NodeLocs) ENDIF @@ -6219,14 +6116,12 @@ SUBROUTINE Morison_CopyJOutput( SrcJOutputData, DstJOutputData, CtrlCode, ErrSta DstJOutputData%JointIDIndx = SrcJOutputData%JointIDIndx END SUBROUTINE Morison_CopyJOutput - SUBROUTINE Morison_DestroyJOutput( JOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyJOutput( JOutputData, ErrStat, ErrMsg ) TYPE(Morison_JOutput), INTENT(INOUT) :: JOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyJOutput' @@ -6234,12 +6129,6 @@ SUBROUTINE Morison_DestroyJOutput( JOutputData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Morison_DestroyJOutput SUBROUTINE Morison_PackJOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -6588,198 +6477,17 @@ SUBROUTINE Morison_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%NumOuts = SrcInitInputData%NumOuts DstInitInputData%UnSum = SrcInitInputData%UnSum DstInitInputData%NStepWave = SrcInitInputData%NStepWave -IF (ASSOCIATED(SrcInitInputData%WaveElev1)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElev1,1) - i1_u = UBOUND(SrcInitInputData%WaveElev1,1) - i2_l = LBOUND(SrcInitInputData%WaveElev1,2) - i2_u = UBOUND(SrcInitInputData%WaveElev1,2) - i3_l = LBOUND(SrcInitInputData%WaveElev1,3) - i3_u = UBOUND(SrcInitInputData%WaveElev1,3) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveElev1)) THEN - ALLOCATE(DstInitInputData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElev1 = SrcInitInputData%WaveElev1 -ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveElev2)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElev2,1) - i1_u = UBOUND(SrcInitInputData%WaveElev2,1) - i2_l = LBOUND(SrcInitInputData%WaveElev2,2) - i2_u = UBOUND(SrcInitInputData%WaveElev2,2) - i3_l = LBOUND(SrcInitInputData%WaveElev2,3) - i3_u = UBOUND(SrcInitInputData%WaveElev2,3) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveElev2)) THEN - ALLOCATE(DstInitInputData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElev2 = SrcInitInputData%WaveElev2 -ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveAcc)) THEN - i1_l = LBOUND(SrcInitInputData%WaveAcc,1) - i1_u = UBOUND(SrcInitInputData%WaveAcc,1) - i2_l = LBOUND(SrcInitInputData%WaveAcc,2) - i2_u = UBOUND(SrcInitInputData%WaveAcc,2) - i3_l = LBOUND(SrcInitInputData%WaveAcc,3) - i3_u = UBOUND(SrcInitInputData%WaveAcc,3) - i4_l = LBOUND(SrcInitInputData%WaveAcc,4) - i4_u = UBOUND(SrcInitInputData%WaveAcc,4) - i5_l = LBOUND(SrcInitInputData%WaveAcc,5) - i5_u = UBOUND(SrcInitInputData%WaveAcc,5) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveAcc)) THEN - ALLOCATE(DstInitInputData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveAcc = SrcInitInputData%WaveAcc -ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveAccMCF)) THEN - i1_l = LBOUND(SrcInitInputData%WaveAccMCF,1) - i1_u = UBOUND(SrcInitInputData%WaveAccMCF,1) - i2_l = LBOUND(SrcInitInputData%WaveAccMCF,2) - i2_u = UBOUND(SrcInitInputData%WaveAccMCF,2) - i3_l = LBOUND(SrcInitInputData%WaveAccMCF,3) - i3_u = UBOUND(SrcInitInputData%WaveAccMCF,3) - i4_l = LBOUND(SrcInitInputData%WaveAccMCF,4) - i4_u = UBOUND(SrcInitInputData%WaveAccMCF,4) - i5_l = LBOUND(SrcInitInputData%WaveAccMCF,5) - i5_u = UBOUND(SrcInitInputData%WaveAccMCF,5) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveAccMCF)) THEN - ALLOCATE(DstInitInputData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveAccMCF = SrcInitInputData%WaveAccMCF -ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveTime)) THEN - i1_l = LBOUND(SrcInitInputData%WaveTime,1) - i1_u = UBOUND(SrcInitInputData%WaveTime,1) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveTime)) THEN - ALLOCATE(DstInitInputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveTime = SrcInitInputData%WaveTime -ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveDynP)) THEN - i1_l = LBOUND(SrcInitInputData%WaveDynP,1) - i1_u = UBOUND(SrcInitInputData%WaveDynP,1) - i2_l = LBOUND(SrcInitInputData%WaveDynP,2) - i2_u = UBOUND(SrcInitInputData%WaveDynP,2) - i3_l = LBOUND(SrcInitInputData%WaveDynP,3) - i3_u = UBOUND(SrcInitInputData%WaveDynP,3) - i4_l = LBOUND(SrcInitInputData%WaveDynP,4) - i4_u = UBOUND(SrcInitInputData%WaveDynP,4) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveDynP)) THEN - ALLOCATE(DstInitInputData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveDynP = SrcInitInputData%WaveDynP -ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveVel)) THEN - i1_l = LBOUND(SrcInitInputData%WaveVel,1) - i1_u = UBOUND(SrcInitInputData%WaveVel,1) - i2_l = LBOUND(SrcInitInputData%WaveVel,2) - i2_u = UBOUND(SrcInitInputData%WaveVel,2) - i3_l = LBOUND(SrcInitInputData%WaveVel,3) - i3_u = UBOUND(SrcInitInputData%WaveVel,3) - i4_l = LBOUND(SrcInitInputData%WaveVel,4) - i4_u = UBOUND(SrcInitInputData%WaveVel,4) - i5_l = LBOUND(SrcInitInputData%WaveVel,5) - i5_u = UBOUND(SrcInitInputData%WaveVel,5) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveVel)) THEN - ALLOCATE(DstInitInputData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveVel = SrcInitInputData%WaveVel -ENDIF -IF (ASSOCIATED(SrcInitInputData%PWaveAcc0)) THEN - i1_l = LBOUND(SrcInitInputData%PWaveAcc0,1) - i1_u = UBOUND(SrcInitInputData%PWaveAcc0,1) - i2_l = LBOUND(SrcInitInputData%PWaveAcc0,2) - i2_u = UBOUND(SrcInitInputData%PWaveAcc0,2) - i3_l = LBOUND(SrcInitInputData%PWaveAcc0,3) - i3_u = UBOUND(SrcInitInputData%PWaveAcc0,3) - i4_l = LBOUND(SrcInitInputData%PWaveAcc0,4) - i4_u = UBOUND(SrcInitInputData%PWaveAcc0,4) - IF (.NOT. ASSOCIATED(DstInitInputData%PWaveAcc0)) THEN - ALLOCATE(DstInitInputData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PWaveAcc0 = SrcInitInputData%PWaveAcc0 -ENDIF -IF (ASSOCIATED(SrcInitInputData%PWaveAccMCF0)) THEN - i1_l = LBOUND(SrcInitInputData%PWaveAccMCF0,1) - i1_u = UBOUND(SrcInitInputData%PWaveAccMCF0,1) - i2_l = LBOUND(SrcInitInputData%PWaveAccMCF0,2) - i2_u = UBOUND(SrcInitInputData%PWaveAccMCF0,2) - i3_l = LBOUND(SrcInitInputData%PWaveAccMCF0,3) - i3_u = UBOUND(SrcInitInputData%PWaveAccMCF0,3) - i4_l = LBOUND(SrcInitInputData%PWaveAccMCF0,4) - i4_u = UBOUND(SrcInitInputData%PWaveAccMCF0,4) - IF (.NOT. ASSOCIATED(DstInitInputData%PWaveAccMCF0)) THEN - ALLOCATE(DstInitInputData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PWaveAccMCF0 = SrcInitInputData%PWaveAccMCF0 -ENDIF -IF (ASSOCIATED(SrcInitInputData%PWaveDynP0)) THEN - i1_l = LBOUND(SrcInitInputData%PWaveDynP0,1) - i1_u = UBOUND(SrcInitInputData%PWaveDynP0,1) - i2_l = LBOUND(SrcInitInputData%PWaveDynP0,2) - i2_u = UBOUND(SrcInitInputData%PWaveDynP0,2) - i3_l = LBOUND(SrcInitInputData%PWaveDynP0,3) - i3_u = UBOUND(SrcInitInputData%PWaveDynP0,3) - IF (.NOT. ASSOCIATED(DstInitInputData%PWaveDynP0)) THEN - ALLOCATE(DstInitInputData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PWaveDynP0 = SrcInitInputData%PWaveDynP0 -ENDIF -IF (ASSOCIATED(SrcInitInputData%PWaveVel0)) THEN - i1_l = LBOUND(SrcInitInputData%PWaveVel0,1) - i1_u = UBOUND(SrcInitInputData%PWaveVel0,1) - i2_l = LBOUND(SrcInitInputData%PWaveVel0,2) - i2_u = UBOUND(SrcInitInputData%PWaveVel0,2) - i3_l = LBOUND(SrcInitInputData%PWaveVel0,3) - i3_u = UBOUND(SrcInitInputData%PWaveVel0,3) - i4_l = LBOUND(SrcInitInputData%PWaveVel0,4) - i4_u = UBOUND(SrcInitInputData%PWaveVel0,4) - IF (.NOT. ASSOCIATED(DstInitInputData%PWaveVel0)) THEN - ALLOCATE(DstInitInputData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PWaveVel0 = SrcInitInputData%PWaveVel0 -ENDIF + DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 + DstInitInputData%WaveElev2 => SrcInitInputData%WaveElev2 + DstInitInputData%WaveAcc => SrcInitInputData%WaveAcc + DstInitInputData%WaveAccMCF => SrcInitInputData%WaveAccMCF + DstInitInputData%WaveTime => SrcInitInputData%WaveTime + DstInitInputData%WaveDynP => SrcInitInputData%WaveDynP + DstInitInputData%WaveVel => SrcInitInputData%WaveVel + DstInitInputData%PWaveAcc0 => SrcInitInputData%PWaveAcc0 + DstInitInputData%PWaveAccMCF0 => SrcInitInputData%PWaveAccMCF0 + DstInitInputData%PWaveDynP0 => SrcInitInputData%PWaveDynP0 + DstInitInputData%PWaveVel0 => SrcInitInputData%PWaveVel0 CALL SeaSt_Interp_CopyParam( SrcInitInputData%SeaSt_Interp_p, DstInitInputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN @@ -6790,14 +6498,12 @@ SUBROUTINE Morison_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE Morison_CopyInitInput - SUBROUTINE Morison_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(Morison_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyInitInput' @@ -6805,85 +6511,79 @@ SUBROUTINE Morison_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%InpJoints)) THEN DO i1 = LBOUND(InitInputData%InpJoints,1), UBOUND(InitInputData%InpJoints,1) - CALL Morison_Destroyjointtype( InitInputData%InpJoints(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyJointType( InitInputData%InpJoints(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InitInputData%InpJoints) ENDIF IF (ALLOCATED(InitInputData%Nodes)) THEN DO i1 = LBOUND(InitInputData%Nodes,1), UBOUND(InitInputData%Nodes,1) - CALL Morison_Destroynodetype( InitInputData%Nodes(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyNodeType( InitInputData%Nodes(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InitInputData%Nodes) ENDIF IF (ALLOCATED(InitInputData%AxialCoefs)) THEN DO i1 = LBOUND(InitInputData%AxialCoefs,1), UBOUND(InitInputData%AxialCoefs,1) - CALL Morison_Destroyaxialcoeftype( InitInputData%AxialCoefs(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyAxialCoefType( InitInputData%AxialCoefs(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InitInputData%AxialCoefs) ENDIF IF (ALLOCATED(InitInputData%MPropSets)) THEN DO i1 = LBOUND(InitInputData%MPropSets,1), UBOUND(InitInputData%MPropSets,1) - CALL Morison_Destroymemberproptype( InitInputData%MPropSets(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyMemberPropType( InitInputData%MPropSets(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InitInputData%MPropSets) ENDIF IF (ALLOCATED(InitInputData%CoefDpths)) THEN DO i1 = LBOUND(InitInputData%CoefDpths,1), UBOUND(InitInputData%CoefDpths,1) - CALL Morison_Destroycoefdpths( InitInputData%CoefDpths(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyCoefDpths( InitInputData%CoefDpths(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InitInputData%CoefDpths) ENDIF IF (ALLOCATED(InitInputData%CoefMembers)) THEN DO i1 = LBOUND(InitInputData%CoefMembers,1), UBOUND(InitInputData%CoefMembers,1) - CALL Morison_Destroycoefmembers( InitInputData%CoefMembers(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyCoefMembers( InitInputData%CoefMembers(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InitInputData%CoefMembers) ENDIF IF (ALLOCATED(InitInputData%InpMembers)) THEN DO i1 = LBOUND(InitInputData%InpMembers,1), UBOUND(InitInputData%InpMembers,1) - CALL Morison_Destroymemberinputtype( InitInputData%InpMembers(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyMemberInputType( InitInputData%InpMembers(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InitInputData%InpMembers) ENDIF IF (ALLOCATED(InitInputData%FilledGroups)) THEN DO i1 = LBOUND(InitInputData%FilledGroups,1), UBOUND(InitInputData%FilledGroups,1) - CALL Morison_Destroyfilledgrouptype( InitInputData%FilledGroups(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyFilledGroupType( InitInputData%FilledGroups(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InitInputData%FilledGroups) ENDIF IF (ALLOCATED(InitInputData%MGDepths)) THEN DO i1 = LBOUND(InitInputData%MGDepths,1), UBOUND(InitInputData%MGDepths,1) - CALL Morison_Destroymgdepthstype( InitInputData%MGDepths(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyMGDepthsType( InitInputData%MGDepths(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InitInputData%MGDepths) ENDIF IF (ALLOCATED(InitInputData%MOutLst)) THEN DO i1 = LBOUND(InitInputData%MOutLst,1), UBOUND(InitInputData%MOutLst,1) - CALL Morison_Destroymoutput( InitInputData%MOutLst(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyMOutput( InitInputData%MOutLst(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InitInputData%MOutLst) ENDIF IF (ALLOCATED(InitInputData%JOutLst)) THEN DO i1 = LBOUND(InitInputData%JOutLst,1), UBOUND(InitInputData%JOutLst,1) - CALL Morison_Destroyjoutput( InitInputData%JOutLst(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyJOutput( InitInputData%JOutLst(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InitInputData%JOutLst) @@ -6891,64 +6591,20 @@ SUBROUTINE Morison_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEp IF (ALLOCATED(InitInputData%OutList)) THEN DEALLOCATE(InitInputData%OutList) ENDIF -IF (ASSOCIATED(InitInputData%WaveElev1)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveElev1) - InitInputData%WaveElev1 => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%WaveElev2)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveElev2) - InitInputData%WaveElev2 => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%WaveAcc)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveAcc) - InitInputData%WaveAcc => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%WaveAccMCF)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveAccMCF) - InitInputData%WaveAccMCF => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%WaveTime)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveTime) - InitInputData%WaveTime => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%WaveDynP)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveDynP) - InitInputData%WaveDynP => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%WaveVel)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveVel) - InitInputData%WaveVel => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%PWaveAcc0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%PWaveAcc0) - InitInputData%PWaveAcc0 => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%PWaveAccMCF0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%PWaveAccMCF0) - InitInputData%PWaveAccMCF0 => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%PWaveDynP0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%PWaveDynP0) - InitInputData%PWaveDynP0 => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%PWaveVel0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%PWaveVel0) - InitInputData%PWaveVel0 => NULL() -ENDIF - CALL SeaSt_Interp_DestroyParam( InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +NULLIFY(InitInputData%WaveElev1) +NULLIFY(InitInputData%WaveElev2) +NULLIFY(InitInputData%WaveAcc) +NULLIFY(InitInputData%WaveAccMCF) +NULLIFY(InitInputData%WaveTime) +NULLIFY(InitInputData%WaveDynP) +NULLIFY(InitInputData%WaveVel) +NULLIFY(InitInputData%PWaveAcc0) +NULLIFY(InitInputData%PWaveAccMCF0) +NULLIFY(InitInputData%PWaveDynP0) +NULLIFY(InitInputData%PWaveVel0) + CALL SeaSt_Interp_DestroyParam( InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_WaveField_Destroyseast_wavefieldtype( InitInputData%WaveField, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_WaveField_DestroySeaSt_WaveFieldType( InitInputData%WaveField, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Morison_DestroyInitInput @@ -7001,7 +6657,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%InpJoints,1), UBOUND(InData%InpJoints,1) Int_BufSz = Int_BufSz + 3 ! InpJoints: size of buffers for each call to pack subtype - CALL Morison_Packjointtype( Re_Buf, Db_Buf, Int_Buf, InData%InpJoints(i1), ErrStat2, ErrMsg2, .TRUE. ) ! InpJoints + CALL Morison_PackJointType( Re_Buf, Db_Buf, Int_Buf, InData%InpJoints(i1), ErrStat2, ErrMsg2, .TRUE. ) ! InpJoints CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7024,7 +6680,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! Nodes upper/lower bounds for each dimension DO i1 = LBOUND(InData%Nodes,1), UBOUND(InData%Nodes,1) Int_BufSz = Int_BufSz + 3 ! Nodes: size of buffers for each call to pack subtype - CALL Morison_Packnodetype( Re_Buf, Db_Buf, Int_Buf, InData%Nodes(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Nodes + CALL Morison_PackNodeType( Re_Buf, Db_Buf, Int_Buf, InData%Nodes(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Nodes CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7048,7 +6704,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! AxialCoefs upper/lower bounds for each dimension DO i1 = LBOUND(InData%AxialCoefs,1), UBOUND(InData%AxialCoefs,1) Int_BufSz = Int_BufSz + 3 ! AxialCoefs: size of buffers for each call to pack subtype - CALL Morison_Packaxialcoeftype( Re_Buf, Db_Buf, Int_Buf, InData%AxialCoefs(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AxialCoefs + CALL Morison_PackAxialCoefType( Re_Buf, Db_Buf, Int_Buf, InData%AxialCoefs(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AxialCoefs CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7072,7 +6728,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! MPropSets upper/lower bounds for each dimension DO i1 = LBOUND(InData%MPropSets,1), UBOUND(InData%MPropSets,1) Int_BufSz = Int_BufSz + 3 ! MPropSets: size of buffers for each call to pack subtype - CALL Morison_Packmemberproptype( Re_Buf, Db_Buf, Int_Buf, InData%MPropSets(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MPropSets + CALL Morison_PackMemberPropType( Re_Buf, Db_Buf, Int_Buf, InData%MPropSets(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MPropSets CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7111,7 +6767,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! CoefDpths upper/lower bounds for each dimension DO i1 = LBOUND(InData%CoefDpths,1), UBOUND(InData%CoefDpths,1) Int_BufSz = Int_BufSz + 3 ! CoefDpths: size of buffers for each call to pack subtype - CALL Morison_Packcoefdpths( Re_Buf, Db_Buf, Int_Buf, InData%CoefDpths(i1), ErrStat2, ErrMsg2, .TRUE. ) ! CoefDpths + CALL Morison_PackCoefDpths( Re_Buf, Db_Buf, Int_Buf, InData%CoefDpths(i1), ErrStat2, ErrMsg2, .TRUE. ) ! CoefDpths CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7135,7 +6791,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! CoefMembers upper/lower bounds for each dimension DO i1 = LBOUND(InData%CoefMembers,1), UBOUND(InData%CoefMembers,1) Int_BufSz = Int_BufSz + 3 ! CoefMembers: size of buffers for each call to pack subtype - CALL Morison_Packcoefmembers( Re_Buf, Db_Buf, Int_Buf, InData%CoefMembers(i1), ErrStat2, ErrMsg2, .TRUE. ) ! CoefMembers + CALL Morison_PackCoefMembers( Re_Buf, Db_Buf, Int_Buf, InData%CoefMembers(i1), ErrStat2, ErrMsg2, .TRUE. ) ! CoefMembers CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7159,7 +6815,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! InpMembers upper/lower bounds for each dimension DO i1 = LBOUND(InData%InpMembers,1), UBOUND(InData%InpMembers,1) Int_BufSz = Int_BufSz + 3 ! InpMembers: size of buffers for each call to pack subtype - CALL Morison_Packmemberinputtype( Re_Buf, Db_Buf, Int_Buf, InData%InpMembers(i1), ErrStat2, ErrMsg2, .TRUE. ) ! InpMembers + CALL Morison_PackMemberInputType( Re_Buf, Db_Buf, Int_Buf, InData%InpMembers(i1), ErrStat2, ErrMsg2, .TRUE. ) ! InpMembers CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7183,7 +6839,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! FilledGroups upper/lower bounds for each dimension DO i1 = LBOUND(InData%FilledGroups,1), UBOUND(InData%FilledGroups,1) Int_BufSz = Int_BufSz + 3 ! FilledGroups: size of buffers for each call to pack subtype - CALL Morison_Packfilledgrouptype( Re_Buf, Db_Buf, Int_Buf, InData%FilledGroups(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FilledGroups + CALL Morison_PackFilledGroupType( Re_Buf, Db_Buf, Int_Buf, InData%FilledGroups(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FilledGroups CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7207,7 +6863,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! MGDepths upper/lower bounds for each dimension DO i1 = LBOUND(InData%MGDepths,1), UBOUND(InData%MGDepths,1) Int_BufSz = Int_BufSz + 3 ! MGDepths: size of buffers for each call to pack subtype - CALL Morison_Packmgdepthstype( Re_Buf, Db_Buf, Int_Buf, InData%MGDepths(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MGDepths + CALL Morison_PackMGDepthsType( Re_Buf, Db_Buf, Int_Buf, InData%MGDepths(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MGDepths CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7233,7 +6889,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! MOutLst upper/lower bounds for each dimension DO i1 = LBOUND(InData%MOutLst,1), UBOUND(InData%MOutLst,1) Int_BufSz = Int_BufSz + 3 ! MOutLst: size of buffers for each call to pack subtype - CALL Morison_Packmoutput( Re_Buf, Db_Buf, Int_Buf, InData%MOutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MOutLst + CALL Morison_PackMOutput( Re_Buf, Db_Buf, Int_Buf, InData%MOutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MOutLst CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7257,7 +6913,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! JOutLst upper/lower bounds for each dimension DO i1 = LBOUND(InData%JOutLst,1), UBOUND(InData%JOutLst,1) Int_BufSz = Int_BufSz + 3 ! JOutLst: size of buffers for each call to pack subtype - CALL Morison_Packjoutput( Re_Buf, Db_Buf, Int_Buf, InData%JOutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! JOutLst + CALL Morison_PackJOutput( Re_Buf, Db_Buf, Int_Buf, InData%JOutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! JOutLst CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7283,61 +6939,6 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 1 ! NumOuts Int_BufSz = Int_BufSz + 1 ! UnSum Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! WaveElev1 allocated yes/no - IF ( ASSOCIATED(InData%WaveElev1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElev1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev1) ! WaveElev1 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev2 allocated yes/no - IF ( ASSOCIATED(InData%WaveElev2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElev2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev2) ! WaveElev2 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc allocated yes/no - IF ( ASSOCIATED(InData%WaveAcc) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveAcc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc) ! WaveAcc - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAccMCF allocated yes/no - IF ( ASSOCIATED(InData%WaveAccMCF) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveAccMCF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAccMCF) ! WaveAccMCF - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ASSOCIATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP allocated yes/no - IF ( ASSOCIATED(InData%WaveDynP) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! WaveDynP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP) ! WaveDynP - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel allocated yes/no - IF ( ASSOCIATED(InData%WaveVel) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel) ! WaveVel - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveAcc0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveAcc0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveAcc0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveAcc0) ! PWaveAcc0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveAccMCF0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveAccMCF0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveAccMCF0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveAccMCF0) ! PWaveAccMCF0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveDynP0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveDynP0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PWaveDynP0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveDynP0) ! PWaveDynP0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveVel0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveVel0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveVel0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveVel0) ! PWaveVel0 - END IF Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_p: size of buffers for each call to pack subtype CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt_Interp_p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7358,7 +6959,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 1 ! WaveStMod Re_BufSz = Re_BufSz + 1 ! MCFD Int_BufSz = Int_BufSz + 3 ! WaveField: size of buffers for each call to pack subtype - CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField + CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7428,7 +7029,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%InpJoints,1), UBOUND(InData%InpJoints,1) - CALL Morison_Packjointtype( Re_Buf, Db_Buf, Int_Buf, InData%InpJoints(i1), ErrStat2, ErrMsg2, OnlySize ) ! InpJoints + CALL Morison_PackJointType( Re_Buf, Db_Buf, Int_Buf, InData%InpJoints(i1), ErrStat2, ErrMsg2, OnlySize ) ! InpJoints CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7469,7 +7070,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%Nodes,1), UBOUND(InData%Nodes,1) - CALL Morison_Packnodetype( Re_Buf, Db_Buf, Int_Buf, InData%Nodes(i1), ErrStat2, ErrMsg2, OnlySize ) ! Nodes + CALL Morison_PackNodeType( Re_Buf, Db_Buf, Int_Buf, InData%Nodes(i1), ErrStat2, ErrMsg2, OnlySize ) ! Nodes CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7512,7 +7113,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%AxialCoefs,1), UBOUND(InData%AxialCoefs,1) - CALL Morison_Packaxialcoeftype( Re_Buf, Db_Buf, Int_Buf, InData%AxialCoefs(i1), ErrStat2, ErrMsg2, OnlySize ) ! AxialCoefs + CALL Morison_PackAxialCoefType( Re_Buf, Db_Buf, Int_Buf, InData%AxialCoefs(i1), ErrStat2, ErrMsg2, OnlySize ) ! AxialCoefs CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7555,7 +7156,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%MPropSets,1), UBOUND(InData%MPropSets,1) - CALL Morison_Packmemberproptype( Re_Buf, Db_Buf, Int_Buf, InData%MPropSets(i1), ErrStat2, ErrMsg2, OnlySize ) ! MPropSets + CALL Morison_PackMemberPropType( Re_Buf, Db_Buf, Int_Buf, InData%MPropSets(i1), ErrStat2, ErrMsg2, OnlySize ) ! MPropSets CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7628,7 +7229,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%CoefDpths,1), UBOUND(InData%CoefDpths,1) - CALL Morison_Packcoefdpths( Re_Buf, Db_Buf, Int_Buf, InData%CoefDpths(i1), ErrStat2, ErrMsg2, OnlySize ) ! CoefDpths + CALL Morison_PackCoefDpths( Re_Buf, Db_Buf, Int_Buf, InData%CoefDpths(i1), ErrStat2, ErrMsg2, OnlySize ) ! CoefDpths CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7671,7 +7272,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%CoefMembers,1), UBOUND(InData%CoefMembers,1) - CALL Morison_Packcoefmembers( Re_Buf, Db_Buf, Int_Buf, InData%CoefMembers(i1), ErrStat2, ErrMsg2, OnlySize ) ! CoefMembers + CALL Morison_PackCoefMembers( Re_Buf, Db_Buf, Int_Buf, InData%CoefMembers(i1), ErrStat2, ErrMsg2, OnlySize ) ! CoefMembers CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7714,7 +7315,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%InpMembers,1), UBOUND(InData%InpMembers,1) - CALL Morison_Packmemberinputtype( Re_Buf, Db_Buf, Int_Buf, InData%InpMembers(i1), ErrStat2, ErrMsg2, OnlySize ) ! InpMembers + CALL Morison_PackMemberInputType( Re_Buf, Db_Buf, Int_Buf, InData%InpMembers(i1), ErrStat2, ErrMsg2, OnlySize ) ! InpMembers CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7757,7 +7358,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%FilledGroups,1), UBOUND(InData%FilledGroups,1) - CALL Morison_Packfilledgrouptype( Re_Buf, Db_Buf, Int_Buf, InData%FilledGroups(i1), ErrStat2, ErrMsg2, OnlySize ) ! FilledGroups + CALL Morison_PackFilledGroupType( Re_Buf, Db_Buf, Int_Buf, InData%FilledGroups(i1), ErrStat2, ErrMsg2, OnlySize ) ! FilledGroups CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7800,7 +7401,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%MGDepths,1), UBOUND(InData%MGDepths,1) - CALL Morison_Packmgdepthstype( Re_Buf, Db_Buf, Int_Buf, InData%MGDepths(i1), ErrStat2, ErrMsg2, OnlySize ) ! MGDepths + CALL Morison_PackMGDepthsType( Re_Buf, Db_Buf, Int_Buf, InData%MGDepths(i1), ErrStat2, ErrMsg2, OnlySize ) ! MGDepths CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7847,7 +7448,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%MOutLst,1), UBOUND(InData%MOutLst,1) - CALL Morison_Packmoutput( Re_Buf, Db_Buf, Int_Buf, InData%MOutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! MOutLst + CALL Morison_PackMOutput( Re_Buf, Db_Buf, Int_Buf, InData%MOutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! MOutLst CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7890,7 +7491,7 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%JOutLst,1), UBOUND(InData%JOutLst,1) - CALL Morison_Packjoutput( Re_Buf, Db_Buf, Int_Buf, InData%JOutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! JOutLst + CALL Morison_PackJOutput( Re_Buf, Db_Buf, Int_Buf, InData%JOutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! JOutLst CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7943,436 +7544,121 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%NStepWave Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ASSOCIATED(InData%WaveElev1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 + CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IntKiBuf(Int_Xferred) = InData%WaveStMod Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,3) - Int_Xferred = Int_Xferred + 2 + ReKiBuf(Re_Xferred) = InData%MCFD + Re_Xferred = Re_Xferred + 1 + CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - DO i3 = LBOUND(InData%WaveElev1,3), UBOUND(InData%WaveElev1,3) - DO i2 = LBOUND(InData%WaveElev1,2), UBOUND(InData%WaveElev1,2) - DO i1 = LBOUND(InData%WaveElev1,1), UBOUND(InData%WaveElev1,1) - ReKiBuf(Re_Xferred) = InData%WaveElev1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveElev2) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE Morison_PackInitInput + + SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Morison_InitInputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackInitInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDisp = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 + OutData%AMMod = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElev2,3), UBOUND(InData%WaveElev2,3) - DO i2 = LBOUND(InData%WaveElev2,2), UBOUND(InData%WaveElev2,2) - DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) - ReKiBuf(Re_Xferred) = InData%WaveElev2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveAcc) ) THEN - IntKiBuf( Int_Xferred ) = 0 + OutData%NJoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpJoints not allocated Int_Xferred = Int_Xferred + 1 ELSE - IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveAcc,5), UBOUND(InData%WaveAcc,5) - DO i4 = LBOUND(InData%WaveAcc,4), UBOUND(InData%WaveAcc,4) - DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) - DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) - DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveAccMCF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveAccMCF,5), UBOUND(InData%WaveAccMCF,5) - DO i4 = LBOUND(InData%WaveAccMCF,4), UBOUND(InData%WaveAccMCF,4) - DO i3 = LBOUND(InData%WaveAccMCF,3), UBOUND(InData%WaveAccMCF,3) - DO i2 = LBOUND(InData%WaveAccMCF,2), UBOUND(InData%WaveAccMCF,2) - DO i1 = LBOUND(InData%WaveAccMCF,1), UBOUND(InData%WaveAccMCF,1) - ReKiBuf(Re_Xferred) = InData%WaveAccMCF(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveDynP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%WaveDynP,4), UBOUND(InData%WaveDynP,4) - DO i3 = LBOUND(InData%WaveDynP,3), UBOUND(InData%WaveDynP,3) - DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) - DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveVel,5), UBOUND(InData%WaveVel,5) - DO i4 = LBOUND(InData%WaveVel,4), UBOUND(InData%WaveVel,4) - DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) - DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) - DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) - ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveAcc0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveAcc0,4), UBOUND(InData%PWaveAcc0,4) - DO i3 = LBOUND(InData%PWaveAcc0,3), UBOUND(InData%PWaveAcc0,3) - DO i2 = LBOUND(InData%PWaveAcc0,2), UBOUND(InData%PWaveAcc0,2) - DO i1 = LBOUND(InData%PWaveAcc0,1), UBOUND(InData%PWaveAcc0,1) - ReKiBuf(Re_Xferred) = InData%PWaveAcc0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveAccMCF0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveAccMCF0,4), UBOUND(InData%PWaveAccMCF0,4) - DO i3 = LBOUND(InData%PWaveAccMCF0,3), UBOUND(InData%PWaveAccMCF0,3) - DO i2 = LBOUND(InData%PWaveAccMCF0,2), UBOUND(InData%PWaveAccMCF0,2) - DO i1 = LBOUND(InData%PWaveAccMCF0,1), UBOUND(InData%PWaveAccMCF0,1) - ReKiBuf(Re_Xferred) = InData%PWaveAccMCF0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveDynP0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PWaveDynP0,3), UBOUND(InData%PWaveDynP0,3) - DO i2 = LBOUND(InData%PWaveDynP0,2), UBOUND(InData%PWaveDynP0,2) - DO i1 = LBOUND(InData%PWaveDynP0,1), UBOUND(InData%PWaveDynP0,1) - ReKiBuf(Re_Xferred) = InData%PWaveDynP0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveVel0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveVel0,4), UBOUND(InData%PWaveVel0,4) - DO i3 = LBOUND(InData%PWaveVel0,3), UBOUND(InData%PWaveVel0,3) - DO i2 = LBOUND(InData%PWaveVel0,2), UBOUND(InData%PWaveVel0,2) - DO i1 = LBOUND(InData%PWaveVel0,1), UBOUND(InData%PWaveVel0,1) - ReKiBuf(Re_Xferred) = InData%PWaveVel0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MCFD - Re_Xferred = Re_Xferred + 1 - CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE Morison_PackInitInput - - SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDisp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AMMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NJoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpJoints not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 IF (ALLOCATED(OutData%InpJoints)) DEALLOCATE(OutData%InpJoints) ALLOCATE(OutData%InpJoints(i1_l:i1_u),STAT=ErrStat2) @@ -8414,7 +7700,7 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Morison_Unpackjointtype( Re_Buf, Db_Buf, Int_Buf, OutData%InpJoints(i1), ErrStat2, ErrMsg2 ) ! InpJoints + CALL Morison_UnpackJointType( Re_Buf, Db_Buf, Int_Buf, OutData%InpJoints(i1), ErrStat2, ErrMsg2 ) ! InpJoints CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8470,7 +7756,7 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Morison_Unpacknodetype( Re_Buf, Db_Buf, Int_Buf, OutData%Nodes(i1), ErrStat2, ErrMsg2 ) ! Nodes + CALL Morison_UnpackNodeType( Re_Buf, Db_Buf, Int_Buf, OutData%Nodes(i1), ErrStat2, ErrMsg2 ) ! Nodes CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8528,7 +7814,7 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Morison_Unpackaxialcoeftype( Re_Buf, Db_Buf, Int_Buf, OutData%AxialCoefs(i1), ErrStat2, ErrMsg2 ) ! AxialCoefs + CALL Morison_UnpackAxialCoefType( Re_Buf, Db_Buf, Int_Buf, OutData%AxialCoefs(i1), ErrStat2, ErrMsg2 ) ! AxialCoefs CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8586,7 +7872,7 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Morison_Unpackmemberproptype( Re_Buf, Db_Buf, Int_Buf, OutData%MPropSets(i1), ErrStat2, ErrMsg2 ) ! MPropSets + CALL Morison_UnpackMemberPropType( Re_Buf, Db_Buf, Int_Buf, OutData%MPropSets(i1), ErrStat2, ErrMsg2 ) ! MPropSets CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8674,7 +7960,7 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Morison_Unpackcoefdpths( Re_Buf, Db_Buf, Int_Buf, OutData%CoefDpths(i1), ErrStat2, ErrMsg2 ) ! CoefDpths + CALL Morison_UnpackCoefDpths( Re_Buf, Db_Buf, Int_Buf, OutData%CoefDpths(i1), ErrStat2, ErrMsg2 ) ! CoefDpths CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8732,7 +8018,7 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Morison_Unpackcoefmembers( Re_Buf, Db_Buf, Int_Buf, OutData%CoefMembers(i1), ErrStat2, ErrMsg2 ) ! CoefMembers + CALL Morison_UnpackCoefMembers( Re_Buf, Db_Buf, Int_Buf, OutData%CoefMembers(i1), ErrStat2, ErrMsg2 ) ! CoefMembers CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8790,7 +8076,7 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Morison_Unpackmemberinputtype( Re_Buf, Db_Buf, Int_Buf, OutData%InpMembers(i1), ErrStat2, ErrMsg2 ) ! InpMembers + CALL Morison_UnpackMemberInputType( Re_Buf, Db_Buf, Int_Buf, OutData%InpMembers(i1), ErrStat2, ErrMsg2 ) ! InpMembers CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8848,7 +8134,7 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Morison_Unpackfilledgrouptype( Re_Buf, Db_Buf, Int_Buf, OutData%FilledGroups(i1), ErrStat2, ErrMsg2 ) ! FilledGroups + CALL Morison_UnpackFilledGroupType( Re_Buf, Db_Buf, Int_Buf, OutData%FilledGroups(i1), ErrStat2, ErrMsg2 ) ! FilledGroups CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8902,513 +8188,176 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_Unpackmgdepthstype( Re_Buf, Db_Buf, Int_Buf, OutData%MGDepths(i1), ErrStat2, ErrMsg2 ) ! MGDepths - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%MGTop = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MGBottom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NMOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MOutLst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MOutLst)) DEALLOCATE(OutData%MOutLst) - ALLOCATE(OutData%MOutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MOutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MOutLst,1), UBOUND(OutData%MOutLst,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_Unpackmoutput( Re_Buf, Db_Buf, Int_Buf, OutData%MOutLst(i1), ErrStat2, ErrMsg2 ) ! MOutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%NJOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JOutLst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%JOutLst)) DEALLOCATE(OutData%JOutLst) - ALLOCATE(OutData%JOutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%JOutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%JOutLst,1), UBOUND(OutData%JOutLst,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_Unpackjoutput( Re_Buf, Db_Buf, Int_Buf, OutData%JOutLst(i1), ErrStat2, ErrMsg2 ) ! JOutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutList)) DEALLOCATE(OutData%OutList) - ALLOCATE(OutData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElev1)) DEALLOCATE(OutData%WaveElev1) - ALLOCATE(OutData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElev1,3), UBOUND(OutData%WaveElev1,3) - DO i2 = LBOUND(OutData%WaveElev1,2), UBOUND(OutData%WaveElev1,2) - DO i1 = LBOUND(OutData%WaveElev1,1), UBOUND(OutData%WaveElev1,1) - OutData%WaveElev1(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElev2)) DEALLOCATE(OutData%WaveElev2) - ALLOCATE(OutData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElev2,3), UBOUND(OutData%WaveElev2,3) - DO i2 = LBOUND(OutData%WaveElev2,2), UBOUND(OutData%WaveElev2,2) - DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) - OutData%WaveElev2(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveAcc)) DEALLOCATE(OutData%WaveAcc) - ALLOCATE(OutData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAcc,5), UBOUND(OutData%WaveAcc,5) - DO i4 = LBOUND(OutData%WaveAcc,4), UBOUND(OutData%WaveAcc,4) - DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) - DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) - DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) - OutData%WaveAcc(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAccMCF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveAccMCF)) DEALLOCATE(OutData%WaveAccMCF) - ALLOCATE(OutData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAccMCF,5), UBOUND(OutData%WaveAccMCF,5) - DO i4 = LBOUND(OutData%WaveAccMCF,4), UBOUND(OutData%WaveAccMCF,4) - DO i3 = LBOUND(OutData%WaveAccMCF,3), UBOUND(OutData%WaveAccMCF,3) - DO i2 = LBOUND(OutData%WaveAccMCF,2), UBOUND(OutData%WaveAccMCF,2) - DO i1 = LBOUND(OutData%WaveAccMCF,1), UBOUND(OutData%WaveAccMCF,1) - OutData%WaveAccMCF(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveDynP)) DEALLOCATE(OutData%WaveDynP) - ALLOCATE(OutData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%WaveDynP,4), UBOUND(OutData%WaveDynP,4) - DO i3 = LBOUND(OutData%WaveDynP,3), UBOUND(OutData%WaveDynP,3) - DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) - DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) - OutData%WaveDynP(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveVel)) DEALLOCATE(OutData%WaveVel) - ALLOCATE(OutData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveVel,5), UBOUND(OutData%WaveVel,5) - DO i4 = LBOUND(OutData%WaveVel,4), UBOUND(OutData%WaveVel,4) - DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) - DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) - DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) - OutData%WaveVel(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Morison_UnpackMGDepthsType( Re_Buf, Db_Buf, Int_Buf, OutData%MGDepths(i1), ErrStat2, ErrMsg2 ) ! MGDepths + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAcc0 not allocated + OutData%MGTop = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MGBottom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NMOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MOutLst not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveAcc0)) DEALLOCATE(OutData%PWaveAcc0) - ALLOCATE(OutData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%MOutLst)) DEALLOCATE(OutData%MOutLst) + ALLOCATE(OutData%MOutLst(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MOutLst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i4 = LBOUND(OutData%PWaveAcc0,4), UBOUND(OutData%PWaveAcc0,4) - DO i3 = LBOUND(OutData%PWaveAcc0,3), UBOUND(OutData%PWaveAcc0,3) - DO i2 = LBOUND(OutData%PWaveAcc0,2), UBOUND(OutData%PWaveAcc0,2) - DO i1 = LBOUND(OutData%PWaveAcc0,1), UBOUND(OutData%PWaveAcc0,1) - OutData%PWaveAcc0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO + DO i1 = LBOUND(OutData%MOutLst,1), UBOUND(OutData%MOutLst,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Morison_UnpackMOutput( Re_Buf, Db_Buf, Int_Buf, OutData%MOutLst(i1), ErrStat2, ErrMsg2 ) ! MOutLst + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAccMCF0 not allocated + OutData%NJOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JOutLst not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveAccMCF0)) DEALLOCATE(OutData%PWaveAccMCF0) - ALLOCATE(OutData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%JOutLst)) DEALLOCATE(OutData%JOutLst) + ALLOCATE(OutData%JOutLst(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%JOutLst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i4 = LBOUND(OutData%PWaveAccMCF0,4), UBOUND(OutData%PWaveAccMCF0,4) - DO i3 = LBOUND(OutData%PWaveAccMCF0,3), UBOUND(OutData%PWaveAccMCF0,3) - DO i2 = LBOUND(OutData%PWaveAccMCF0,2), UBOUND(OutData%PWaveAccMCF0,2) - DO i1 = LBOUND(OutData%PWaveAccMCF0,1), UBOUND(OutData%PWaveAccMCF0,1) - OutData%PWaveAccMCF0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO + DO i1 = LBOUND(OutData%JOutLst,1), UBOUND(OutData%JOutLst,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Morison_UnpackJOutput( Re_Buf, Db_Buf, Int_Buf, OutData%JOutLst(i1), ErrStat2, ErrMsg2 ) ! JOutLst + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveDynP0 not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveDynP0)) DEALLOCATE(OutData%PWaveDynP0) - ALLOCATE(OutData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%OutList)) DEALLOCATE(OutData%OutList) + ALLOCATE(OutData%OutList(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i3 = LBOUND(OutData%PWaveDynP0,3), UBOUND(OutData%PWaveDynP0,3) - DO i2 = LBOUND(OutData%PWaveDynP0,2), UBOUND(OutData%PWaveDynP0,2) - DO i1 = LBOUND(OutData%PWaveDynP0,1), UBOUND(OutData%PWaveDynP0,1) - OutData%PWaveDynP0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveVel0 not allocated + OutData%NumOuts = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - ELSE + OutData%UnSum = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveVel0)) DEALLOCATE(OutData%PWaveVel0) - ALLOCATE(OutData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveVel0,4), UBOUND(OutData%PWaveVel0,4) - DO i3 = LBOUND(OutData%PWaveVel0,3), UBOUND(OutData%PWaveVel0,3) - DO i2 = LBOUND(OutData%PWaveVel0,2), UBOUND(OutData%PWaveVel0,2) - DO i1 = LBOUND(OutData%PWaveVel0,1), UBOUND(OutData%PWaveVel0,1) - OutData%PWaveVel0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + NULLIFY(OutData%WaveElev1) + NULLIFY(OutData%WaveElev2) + NULLIFY(OutData%WaveAcc) + NULLIFY(OutData%WaveAccMCF) + NULLIFY(OutData%WaveTime) + NULLIFY(OutData%WaveDynP) + NULLIFY(OutData%WaveVel) + NULLIFY(OutData%PWaveAcc0) + NULLIFY(OutData%PWaveAccMCF0) + NULLIFY(OutData%PWaveDynP0) + NULLIFY(OutData%PWaveVel0) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9486,7 +8435,7 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SeaSt_WaveField_Unpackseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField + CALL SeaSt_WaveField_UnpackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9536,14 +8485,12 @@ SUBROUTINE Morison_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCod ENDIF END SUBROUTINE Morison_CopyInitOutput - SUBROUTINE Morison_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(Morison_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyInitOutput' @@ -9551,12 +8498,6 @@ SUBROUTINE Morison_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCAT ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) ENDIF @@ -9759,14 +8700,12 @@ SUBROUTINE Morison_CopyContState( SrcContStateData, DstContStateData, CtrlCode, DstContStateData%DummyContState = SrcContStateData%DummyContState END SUBROUTINE Morison_CopyContState - SUBROUTINE Morison_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(Morison_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyContState' @@ -9774,12 +8713,6 @@ SUBROUTINE Morison_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Morison_DestroyContState SUBROUTINE Morison_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -9908,14 +8841,12 @@ SUBROUTINE Morison_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ENDIF END SUBROUTINE Morison_CopyDiscState - SUBROUTINE Morison_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(Morison_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyDiscState' @@ -9923,12 +8854,6 @@ SUBROUTINE Morison_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(DiscStateData%V_rel_n_FiltStat)) THEN DEALLOCATE(DiscStateData%V_rel_n_FiltStat) ENDIF @@ -10082,14 +9007,12 @@ SUBROUTINE Morison_CopyConstrState( SrcConstrStateData, DstConstrStateData, Ctrl DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE Morison_CopyConstrState - SUBROUTINE Morison_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(Morison_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyConstrState' @@ -10097,12 +9020,6 @@ SUBROUTINE Morison_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOC ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Morison_DestroyConstrState SUBROUTINE Morison_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -10219,14 +9136,12 @@ SUBROUTINE Morison_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCod DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState END SUBROUTINE Morison_CopyOtherState - SUBROUTINE Morison_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(Morison_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyOtherState' @@ -10234,12 +9149,6 @@ SUBROUTINE Morison_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCAT ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Morison_DestroyOtherState SUBROUTINE Morison_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -10601,14 +9510,12 @@ SUBROUTINE Morison_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE Morison_CopyMisc - SUBROUTINE Morison_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(Morison_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMisc' @@ -10616,12 +9523,6 @@ SUBROUTINE Morison_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MiscData%FV)) THEN DEALLOCATE(MiscData%FV) ENDIF @@ -10651,7 +9552,7 @@ SUBROUTINE Morison_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(MiscData%memberLoads)) THEN DO i1 = LBOUND(MiscData%memberLoads,1), UBOUND(MiscData%memberLoads,1) - CALL Morison_Destroymemberloads( MiscData%memberLoads(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyMemberLoads( MiscData%memberLoads(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%memberLoads) @@ -10680,7 +9581,7 @@ SUBROUTINE Morison_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(MiscData%V_rel_n_HiPass)) THEN DEALLOCATE(MiscData%V_rel_n_HiPass) ENDIF - CALL SeaSt_Interp_DestroyMisc( MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_Interp_DestroyMisc( MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Morison_DestroyMisc @@ -10770,7 +9671,7 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%memberLoads,1), UBOUND(InData%memberLoads,1) Int_BufSz = Int_BufSz + 3 ! memberLoads: size of buffers for each call to pack subtype - CALL Morison_Packmemberloads( Re_Buf, Db_Buf, Int_Buf, InData%memberLoads(i1), ErrStat2, ErrMsg2, .TRUE. ) ! memberLoads + CALL Morison_PackMemberLoads( Re_Buf, Db_Buf, Int_Buf, InData%memberLoads(i1), ErrStat2, ErrMsg2, .TRUE. ) ! memberLoads CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11039,7 +9940,7 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%memberLoads,1), UBOUND(InData%memberLoads,1) - CALL Morison_Packmemberloads( Re_Buf, Db_Buf, Int_Buf, InData%memberLoads(i1), ErrStat2, ErrMsg2, OnlySize ) ! memberLoads + CALL Morison_PackMemberLoads( Re_Buf, Db_Buf, Int_Buf, InData%memberLoads(i1), ErrStat2, ErrMsg2, OnlySize ) ! memberLoads CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11508,7 +10409,7 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Morison_Unpackmemberloads( Re_Buf, Db_Buf, Int_Buf, OutData%memberLoads(i1), ErrStat2, ErrMsg2 ) ! memberLoads + CALL Morison_UnpackMemberLoads( Re_Buf, Db_Buf, Int_Buf, OutData%memberLoads(i1), ErrStat2, ErrMsg2 ) ! memberLoads CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11870,160 +10771,56 @@ SUBROUTINE Morison_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Err RETURN END IF END IF - DstParamData%F_WMG_End = SrcParamData%F_WMG_End -ENDIF -IF (ALLOCATED(SrcParamData%DP_Const_End)) THEN - i1_l = LBOUND(SrcParamData%DP_Const_End,1) - i1_u = UBOUND(SrcParamData%DP_Const_End,1) - i2_l = LBOUND(SrcParamData%DP_Const_End,2) - i2_u = UBOUND(SrcParamData%DP_Const_End,2) - IF (.NOT. ALLOCATED(DstParamData%DP_Const_End)) THEN - ALLOCATE(DstParamData%DP_Const_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DP_Const_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DP_Const_End = SrcParamData%DP_Const_End -ENDIF -IF (ALLOCATED(SrcParamData%Mass_MG_End)) THEN - i1_l = LBOUND(SrcParamData%Mass_MG_End,1) - i1_u = UBOUND(SrcParamData%Mass_MG_End,1) - IF (.NOT. ALLOCATED(DstParamData%Mass_MG_End)) THEN - ALLOCATE(DstParamData%Mass_MG_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Mass_MG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Mass_MG_End = SrcParamData%Mass_MG_End -ENDIF -IF (ALLOCATED(SrcParamData%AM_End)) THEN - i1_l = LBOUND(SrcParamData%AM_End,1) - i1_u = UBOUND(SrcParamData%AM_End,1) - i2_l = LBOUND(SrcParamData%AM_End,2) - i2_u = UBOUND(SrcParamData%AM_End,2) - i3_l = LBOUND(SrcParamData%AM_End,3) - i3_u = UBOUND(SrcParamData%AM_End,3) - IF (.NOT. ALLOCATED(DstParamData%AM_End)) THEN - ALLOCATE(DstParamData%AM_End(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AM_End = SrcParamData%AM_End -ENDIF -IF (ASSOCIATED(SrcParamData%WaveElev1)) THEN - i1_l = LBOUND(SrcParamData%WaveElev1,1) - i1_u = UBOUND(SrcParamData%WaveElev1,1) - i2_l = LBOUND(SrcParamData%WaveElev1,2) - i2_u = UBOUND(SrcParamData%WaveElev1,2) - i3_l = LBOUND(SrcParamData%WaveElev1,3) - i3_u = UBOUND(SrcParamData%WaveElev1,3) - IF (.NOT. ASSOCIATED(DstParamData%WaveElev1)) THEN - ALLOCATE(DstParamData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveElev1 = SrcParamData%WaveElev1 -ENDIF -IF (ASSOCIATED(SrcParamData%WaveElev2)) THEN - i1_l = LBOUND(SrcParamData%WaveElev2,1) - i1_u = UBOUND(SrcParamData%WaveElev2,1) - i2_l = LBOUND(SrcParamData%WaveElev2,2) - i2_u = UBOUND(SrcParamData%WaveElev2,2) - i3_l = LBOUND(SrcParamData%WaveElev2,3) - i3_u = UBOUND(SrcParamData%WaveElev2,3) - IF (.NOT. ASSOCIATED(DstParamData%WaveElev2)) THEN - ALLOCATE(DstParamData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveElev2 = SrcParamData%WaveElev2 -ENDIF -IF (ASSOCIATED(SrcParamData%WaveVel)) THEN - i1_l = LBOUND(SrcParamData%WaveVel,1) - i1_u = UBOUND(SrcParamData%WaveVel,1) - i2_l = LBOUND(SrcParamData%WaveVel,2) - i2_u = UBOUND(SrcParamData%WaveVel,2) - i3_l = LBOUND(SrcParamData%WaveVel,3) - i3_u = UBOUND(SrcParamData%WaveVel,3) - i4_l = LBOUND(SrcParamData%WaveVel,4) - i4_u = UBOUND(SrcParamData%WaveVel,4) - i5_l = LBOUND(SrcParamData%WaveVel,5) - i5_u = UBOUND(SrcParamData%WaveVel,5) - IF (.NOT. ASSOCIATED(DstParamData%WaveVel)) THEN - ALLOCATE(DstParamData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveVel = SrcParamData%WaveVel + DstParamData%F_WMG_End = SrcParamData%F_WMG_End ENDIF -IF (ASSOCIATED(SrcParamData%WaveAcc)) THEN - i1_l = LBOUND(SrcParamData%WaveAcc,1) - i1_u = UBOUND(SrcParamData%WaveAcc,1) - i2_l = LBOUND(SrcParamData%WaveAcc,2) - i2_u = UBOUND(SrcParamData%WaveAcc,2) - i3_l = LBOUND(SrcParamData%WaveAcc,3) - i3_u = UBOUND(SrcParamData%WaveAcc,3) - i4_l = LBOUND(SrcParamData%WaveAcc,4) - i4_u = UBOUND(SrcParamData%WaveAcc,4) - i5_l = LBOUND(SrcParamData%WaveAcc,5) - i5_u = UBOUND(SrcParamData%WaveAcc,5) - IF (.NOT. ASSOCIATED(DstParamData%WaveAcc)) THEN - ALLOCATE(DstParamData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) +IF (ALLOCATED(SrcParamData%DP_Const_End)) THEN + i1_l = LBOUND(SrcParamData%DP_Const_End,1) + i1_u = UBOUND(SrcParamData%DP_Const_End,1) + i2_l = LBOUND(SrcParamData%DP_Const_End,2) + i2_u = UBOUND(SrcParamData%DP_Const_End,2) + IF (.NOT. ALLOCATED(DstParamData%DP_Const_End)) THEN + ALLOCATE(DstParamData%DP_Const_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveAcc.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DP_Const_End.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstParamData%WaveAcc = SrcParamData%WaveAcc + DstParamData%DP_Const_End = SrcParamData%DP_Const_End ENDIF -IF (ASSOCIATED(SrcParamData%WaveAccMCF)) THEN - i1_l = LBOUND(SrcParamData%WaveAccMCF,1) - i1_u = UBOUND(SrcParamData%WaveAccMCF,1) - i2_l = LBOUND(SrcParamData%WaveAccMCF,2) - i2_u = UBOUND(SrcParamData%WaveAccMCF,2) - i3_l = LBOUND(SrcParamData%WaveAccMCF,3) - i3_u = UBOUND(SrcParamData%WaveAccMCF,3) - i4_l = LBOUND(SrcParamData%WaveAccMCF,4) - i4_u = UBOUND(SrcParamData%WaveAccMCF,4) - i5_l = LBOUND(SrcParamData%WaveAccMCF,5) - i5_u = UBOUND(SrcParamData%WaveAccMCF,5) - IF (.NOT. ASSOCIATED(DstParamData%WaveAccMCF)) THEN - ALLOCATE(DstParamData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) +IF (ALLOCATED(SrcParamData%Mass_MG_End)) THEN + i1_l = LBOUND(SrcParamData%Mass_MG_End,1) + i1_u = UBOUND(SrcParamData%Mass_MG_End,1) + IF (.NOT. ALLOCATED(DstParamData%Mass_MG_End)) THEN + ALLOCATE(DstParamData%Mass_MG_End(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Mass_MG_End.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstParamData%WaveAccMCF = SrcParamData%WaveAccMCF + DstParamData%Mass_MG_End = SrcParamData%Mass_MG_End ENDIF -IF (ASSOCIATED(SrcParamData%WaveDynP)) THEN - i1_l = LBOUND(SrcParamData%WaveDynP,1) - i1_u = UBOUND(SrcParamData%WaveDynP,1) - i2_l = LBOUND(SrcParamData%WaveDynP,2) - i2_u = UBOUND(SrcParamData%WaveDynP,2) - i3_l = LBOUND(SrcParamData%WaveDynP,3) - i3_u = UBOUND(SrcParamData%WaveDynP,3) - i4_l = LBOUND(SrcParamData%WaveDynP,4) - i4_u = UBOUND(SrcParamData%WaveDynP,4) - IF (.NOT. ASSOCIATED(DstParamData%WaveDynP)) THEN - ALLOCATE(DstParamData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) +IF (ALLOCATED(SrcParamData%AM_End)) THEN + i1_l = LBOUND(SrcParamData%AM_End,1) + i1_u = UBOUND(SrcParamData%AM_End,1) + i2_l = LBOUND(SrcParamData%AM_End,2) + i2_u = UBOUND(SrcParamData%AM_End,2) + i3_l = LBOUND(SrcParamData%AM_End,3) + i3_u = UBOUND(SrcParamData%AM_End,3) + IF (.NOT. ALLOCATED(DstParamData%AM_End)) THEN + ALLOCATE(DstParamData%AM_End(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveDynP.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM_End.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstParamData%WaveDynP = SrcParamData%WaveDynP + DstParamData%AM_End = SrcParamData%AM_End ENDIF + DstParamData%WaveElev1 => SrcParamData%WaveElev1 + DstParamData%WaveElev2 => SrcParamData%WaveElev2 + DstParamData%WaveVel => SrcParamData%WaveVel + DstParamData%WaveAcc => SrcParamData%WaveAcc + DstParamData%WaveAccMCF => SrcParamData%WaveAccMCF + DstParamData%WaveDynP => SrcParamData%WaveDynP IF (ALLOCATED(SrcParamData%WaveVel0)) THEN i1_l = LBOUND(SrcParamData%WaveVel0,1) i1_u = UBOUND(SrcParamData%WaveVel0,1) @@ -12094,88 +10891,11 @@ SUBROUTINE Morison_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Err END IF DstParamData%WaveDynP0 = SrcParamData%WaveDynP0 ENDIF -IF (ASSOCIATED(SrcParamData%WaveTime)) THEN - i1_l = LBOUND(SrcParamData%WaveTime,1) - i1_u = UBOUND(SrcParamData%WaveTime,1) - IF (.NOT. ASSOCIATED(DstParamData%WaveTime)) THEN - ALLOCATE(DstParamData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveTime = SrcParamData%WaveTime -ENDIF -IF (ASSOCIATED(SrcParamData%PWaveVel0)) THEN - i1_l = LBOUND(SrcParamData%PWaveVel0,1) - i1_u = UBOUND(SrcParamData%PWaveVel0,1) - i2_l = LBOUND(SrcParamData%PWaveVel0,2) - i2_u = UBOUND(SrcParamData%PWaveVel0,2) - i3_l = LBOUND(SrcParamData%PWaveVel0,3) - i3_u = UBOUND(SrcParamData%PWaveVel0,3) - i4_l = LBOUND(SrcParamData%PWaveVel0,4) - i4_u = UBOUND(SrcParamData%PWaveVel0,4) - IF (.NOT. ASSOCIATED(DstParamData%PWaveVel0)) THEN - ALLOCATE(DstParamData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PWaveVel0 = SrcParamData%PWaveVel0 -ENDIF -IF (ASSOCIATED(SrcParamData%PWaveAcc0)) THEN - i1_l = LBOUND(SrcParamData%PWaveAcc0,1) - i1_u = UBOUND(SrcParamData%PWaveAcc0,1) - i2_l = LBOUND(SrcParamData%PWaveAcc0,2) - i2_u = UBOUND(SrcParamData%PWaveAcc0,2) - i3_l = LBOUND(SrcParamData%PWaveAcc0,3) - i3_u = UBOUND(SrcParamData%PWaveAcc0,3) - i4_l = LBOUND(SrcParamData%PWaveAcc0,4) - i4_u = UBOUND(SrcParamData%PWaveAcc0,4) - IF (.NOT. ASSOCIATED(DstParamData%PWaveAcc0)) THEN - ALLOCATE(DstParamData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PWaveAcc0 = SrcParamData%PWaveAcc0 -ENDIF -IF (ASSOCIATED(SrcParamData%PWaveAccMCF0)) THEN - i1_l = LBOUND(SrcParamData%PWaveAccMCF0,1) - i1_u = UBOUND(SrcParamData%PWaveAccMCF0,1) - i2_l = LBOUND(SrcParamData%PWaveAccMCF0,2) - i2_u = UBOUND(SrcParamData%PWaveAccMCF0,2) - i3_l = LBOUND(SrcParamData%PWaveAccMCF0,3) - i3_u = UBOUND(SrcParamData%PWaveAccMCF0,3) - i4_l = LBOUND(SrcParamData%PWaveAccMCF0,4) - i4_u = UBOUND(SrcParamData%PWaveAccMCF0,4) - IF (.NOT. ASSOCIATED(DstParamData%PWaveAccMCF0)) THEN - ALLOCATE(DstParamData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PWaveAccMCF0 = SrcParamData%PWaveAccMCF0 -ENDIF -IF (ASSOCIATED(SrcParamData%PWaveDynP0)) THEN - i1_l = LBOUND(SrcParamData%PWaveDynP0,1) - i1_u = UBOUND(SrcParamData%PWaveDynP0,1) - i2_l = LBOUND(SrcParamData%PWaveDynP0,2) - i2_u = UBOUND(SrcParamData%PWaveDynP0,2) - i3_l = LBOUND(SrcParamData%PWaveDynP0,3) - i3_u = UBOUND(SrcParamData%PWaveDynP0,3) - IF (.NOT. ASSOCIATED(DstParamData%PWaveDynP0)) THEN - ALLOCATE(DstParamData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PWaveDynP0 = SrcParamData%PWaveDynP0 -ENDIF + DstParamData%WaveTime => SrcParamData%WaveTime + DstParamData%PWaveVel0 => SrcParamData%PWaveVel0 + DstParamData%PWaveAcc0 => SrcParamData%PWaveAcc0 + DstParamData%PWaveAccMCF0 => SrcParamData%PWaveAccMCF0 + DstParamData%PWaveDynP0 => SrcParamData%PWaveDynP0 DstParamData%NStepWave = SrcParamData%NStepWave DstParamData%NMOutputs = SrcParamData%NMOutputs IF (ALLOCATED(SrcParamData%MOutLst)) THEN @@ -12237,14 +10957,12 @@ SUBROUTINE Morison_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE Morison_CopyParam - SUBROUTINE Morison_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(Morison_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyParam' @@ -12252,15 +10970,9 @@ SUBROUTINE Morison_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%Members)) THEN DO i1 = LBOUND(ParamData%Members,1), UBOUND(ParamData%Members,1) - CALL Morison_Destroymembertype( ParamData%Members(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyMemberType( ParamData%Members(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%Members) @@ -12295,36 +11007,12 @@ SUBROUTINE Morison_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers IF (ALLOCATED(ParamData%AM_End)) THEN DEALLOCATE(ParamData%AM_End) ENDIF -IF (ASSOCIATED(ParamData%WaveElev1)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%WaveElev1) - ParamData%WaveElev1 => NULL() -ENDIF -IF (ASSOCIATED(ParamData%WaveElev2)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%WaveElev2) - ParamData%WaveElev2 => NULL() -ENDIF -IF (ASSOCIATED(ParamData%WaveVel)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%WaveVel) - ParamData%WaveVel => NULL() -ENDIF -IF (ASSOCIATED(ParamData%WaveAcc)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%WaveAcc) - ParamData%WaveAcc => NULL() -ENDIF -IF (ASSOCIATED(ParamData%WaveAccMCF)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%WaveAccMCF) - ParamData%WaveAccMCF => NULL() -ENDIF -IF (ASSOCIATED(ParamData%WaveDynP)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%WaveDynP) - ParamData%WaveDynP => NULL() -ENDIF +NULLIFY(ParamData%WaveElev1) +NULLIFY(ParamData%WaveElev2) +NULLIFY(ParamData%WaveVel) +NULLIFY(ParamData%WaveAcc) +NULLIFY(ParamData%WaveAccMCF) +NULLIFY(ParamData%WaveDynP) IF (ALLOCATED(ParamData%WaveVel0)) THEN DEALLOCATE(ParamData%WaveVel0) ENDIF @@ -12337,55 +11025,35 @@ SUBROUTINE Morison_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers IF (ALLOCATED(ParamData%WaveDynP0)) THEN DEALLOCATE(ParamData%WaveDynP0) ENDIF -IF (ASSOCIATED(ParamData%WaveTime)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%WaveTime) - ParamData%WaveTime => NULL() -ENDIF -IF (ASSOCIATED(ParamData%PWaveVel0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%PWaveVel0) - ParamData%PWaveVel0 => NULL() -ENDIF -IF (ASSOCIATED(ParamData%PWaveAcc0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%PWaveAcc0) - ParamData%PWaveAcc0 => NULL() -ENDIF -IF (ASSOCIATED(ParamData%PWaveAccMCF0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%PWaveAccMCF0) - ParamData%PWaveAccMCF0 => NULL() -ENDIF -IF (ASSOCIATED(ParamData%PWaveDynP0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%PWaveDynP0) - ParamData%PWaveDynP0 => NULL() -ENDIF +NULLIFY(ParamData%WaveTime) +NULLIFY(ParamData%PWaveVel0) +NULLIFY(ParamData%PWaveAcc0) +NULLIFY(ParamData%PWaveAccMCF0) +NULLIFY(ParamData%PWaveDynP0) IF (ALLOCATED(ParamData%MOutLst)) THEN DO i1 = LBOUND(ParamData%MOutLst,1), UBOUND(ParamData%MOutLst,1) - CALL Morison_Destroymoutput( ParamData%MOutLst(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyMOutput( ParamData%MOutLst(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%MOutLst) ENDIF IF (ALLOCATED(ParamData%JOutLst)) THEN DO i1 = LBOUND(ParamData%JOutLst,1), UBOUND(ParamData%JOutLst,1) - CALL Morison_Destroyjoutput( ParamData%JOutLst(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Morison_DestroyJOutput( ParamData%JOutLst(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%JOutLst) ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) ENDIF - CALL SeaSt_Interp_DestroyParam( ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_Interp_DestroyParam( ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_WaveField_Destroyseast_wavefieldtype( ParamData%WaveField, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_WaveField_DestroySeaSt_WaveFieldType( ParamData%WaveField, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Morison_DestroyParam @@ -12438,7 +11106,7 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%Members,1), UBOUND(InData%Members,1) Int_BufSz = Int_BufSz + 3 ! Members: size of buffers for each call to pack subtype - CALL Morison_Packmembertype( Re_Buf, Db_Buf, Int_Buf, InData%Members(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Members + CALL Morison_PackMemberType( Re_Buf, Db_Buf, Int_Buf, InData%Members(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Members CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12508,36 +11176,6 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 2*3 ! AM_End upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%AM_End) ! AM_End END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev1 allocated yes/no - IF ( ASSOCIATED(InData%WaveElev1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElev1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev1) ! WaveElev1 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev2 allocated yes/no - IF ( ASSOCIATED(InData%WaveElev2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElev2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev2) ! WaveElev2 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel allocated yes/no - IF ( ASSOCIATED(InData%WaveVel) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel) ! WaveVel - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc allocated yes/no - IF ( ASSOCIATED(InData%WaveAcc) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveAcc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc) ! WaveAcc - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAccMCF allocated yes/no - IF ( ASSOCIATED(InData%WaveAccMCF) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveAccMCF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAccMCF) ! WaveAccMCF - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP allocated yes/no - IF ( ASSOCIATED(InData%WaveDynP) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! WaveDynP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP) ! WaveDynP - END IF Int_BufSz = Int_BufSz + 1 ! WaveVel0 allocated yes/no IF ( ALLOCATED(InData%WaveVel0) ) THEN Int_BufSz = Int_BufSz + 2*4 ! WaveVel0 upper/lower bounds for each dimension @@ -12557,31 +11195,6 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IF ( ALLOCATED(InData%WaveDynP0) ) THEN Int_BufSz = Int_BufSz + 2*3 ! WaveDynP0 upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP0) ! WaveDynP0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ASSOCIATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveVel0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveVel0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveVel0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveVel0) ! PWaveVel0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveAcc0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveAcc0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveAcc0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveAcc0) ! PWaveAcc0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveAccMCF0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveAccMCF0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveAccMCF0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveAccMCF0) ! PWaveAccMCF0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveDynP0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveDynP0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PWaveDynP0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveDynP0) ! PWaveDynP0 END IF Int_BufSz = Int_BufSz + 1 ! NStepWave Int_BufSz = Int_BufSz + 1 ! NMOutputs @@ -12590,7 +11203,7 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 2*1 ! MOutLst upper/lower bounds for each dimension DO i1 = LBOUND(InData%MOutLst,1), UBOUND(InData%MOutLst,1) Int_BufSz = Int_BufSz + 3 ! MOutLst: size of buffers for each call to pack subtype - CALL Morison_Packmoutput( Re_Buf, Db_Buf, Int_Buf, InData%MOutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MOutLst + CALL Morison_PackMOutput( Re_Buf, Db_Buf, Int_Buf, InData%MOutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MOutLst CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12614,7 +11227,7 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 2*1 ! JOutLst upper/lower bounds for each dimension DO i1 = LBOUND(InData%JOutLst,1), UBOUND(InData%JOutLst,1) Int_BufSz = Int_BufSz + 3 ! JOutLst: size of buffers for each call to pack subtype - CALL Morison_Packjoutput( Re_Buf, Db_Buf, Int_Buf, InData%JOutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! JOutLst + CALL Morison_PackJOutput( Re_Buf, Db_Buf, Int_Buf, InData%JOutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! JOutLst CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12637,7 +11250,7 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12675,7 +11288,7 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END IF Int_BufSz = Int_BufSz + 1 ! WaveStMod Int_BufSz = Int_BufSz + 3 ! WaveField: size of buffers for each call to pack subtype - CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField + CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12745,7 +11358,7 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%Members,1), UBOUND(InData%Members,1) - CALL Morison_Packmembertype( Re_Buf, Db_Buf, Int_Buf, InData%Members(i1), ErrStat2, ErrMsg2, OnlySize ) ! Members + CALL Morison_PackMemberType( Re_Buf, Db_Buf, Int_Buf, InData%Members(i1), ErrStat2, ErrMsg2, OnlySize ) ! Members CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12964,191 +11577,6 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END DO END DO END IF - IF ( .NOT. ASSOCIATED(InData%WaveElev1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElev1,3), UBOUND(InData%WaveElev1,3) - DO i2 = LBOUND(InData%WaveElev1,2), UBOUND(InData%WaveElev1,2) - DO i1 = LBOUND(InData%WaveElev1,1), UBOUND(InData%WaveElev1,1) - ReKiBuf(Re_Xferred) = InData%WaveElev1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveElev2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElev2,3), UBOUND(InData%WaveElev2,3) - DO i2 = LBOUND(InData%WaveElev2,2), UBOUND(InData%WaveElev2,2) - DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) - ReKiBuf(Re_Xferred) = InData%WaveElev2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveVel,5), UBOUND(InData%WaveVel,5) - DO i4 = LBOUND(InData%WaveVel,4), UBOUND(InData%WaveVel,4) - DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) - DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) - DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) - ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveAcc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveAcc,5), UBOUND(InData%WaveAcc,5) - DO i4 = LBOUND(InData%WaveAcc,4), UBOUND(InData%WaveAcc,4) - DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) - DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) - DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveAccMCF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveAccMCF,5), UBOUND(InData%WaveAccMCF,5) - DO i4 = LBOUND(InData%WaveAccMCF,4), UBOUND(InData%WaveAccMCF,4) - DO i3 = LBOUND(InData%WaveAccMCF,3), UBOUND(InData%WaveAccMCF,3) - DO i2 = LBOUND(InData%WaveAccMCF,2), UBOUND(InData%WaveAccMCF,2) - DO i1 = LBOUND(InData%WaveAccMCF,1), UBOUND(InData%WaveAccMCF,1) - ReKiBuf(Re_Xferred) = InData%WaveAccMCF(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveDynP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%WaveDynP,4), UBOUND(InData%WaveDynP,4) - DO i3 = LBOUND(InData%WaveDynP,3), UBOUND(InData%WaveDynP,3) - DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) - DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF IF ( .NOT. ALLOCATED(InData%WaveVel0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -13251,144 +11679,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP0,2) IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP0,2) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveDynP0,3), UBOUND(InData%WaveDynP0,3) - DO i2 = LBOUND(InData%WaveDynP0,2), UBOUND(InData%WaveDynP0,2) - DO i1 = LBOUND(InData%WaveDynP0,1), UBOUND(InData%WaveDynP0,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveVel0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveVel0,4), UBOUND(InData%PWaveVel0,4) - DO i3 = LBOUND(InData%PWaveVel0,3), UBOUND(InData%PWaveVel0,3) - DO i2 = LBOUND(InData%PWaveVel0,2), UBOUND(InData%PWaveVel0,2) - DO i1 = LBOUND(InData%PWaveVel0,1), UBOUND(InData%PWaveVel0,1) - ReKiBuf(Re_Xferred) = InData%PWaveVel0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveAcc0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveAcc0,4), UBOUND(InData%PWaveAcc0,4) - DO i3 = LBOUND(InData%PWaveAcc0,3), UBOUND(InData%PWaveAcc0,3) - DO i2 = LBOUND(InData%PWaveAcc0,2), UBOUND(InData%PWaveAcc0,2) - DO i1 = LBOUND(InData%PWaveAcc0,1), UBOUND(InData%PWaveAcc0,1) - ReKiBuf(Re_Xferred) = InData%PWaveAcc0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveAccMCF0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveAccMCF0,4), UBOUND(InData%PWaveAccMCF0,4) - DO i3 = LBOUND(InData%PWaveAccMCF0,3), UBOUND(InData%PWaveAccMCF0,3) - DO i2 = LBOUND(InData%PWaveAccMCF0,2), UBOUND(InData%PWaveAccMCF0,2) - DO i1 = LBOUND(InData%PWaveAccMCF0,1), UBOUND(InData%PWaveAccMCF0,1) - ReKiBuf(Re_Xferred) = InData%PWaveAccMCF0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveDynP0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,3) + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP0,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP0,3) Int_Xferred = Int_Xferred + 2 - DO i3 = LBOUND(InData%PWaveDynP0,3), UBOUND(InData%PWaveDynP0,3) - DO i2 = LBOUND(InData%PWaveDynP0,2), UBOUND(InData%PWaveDynP0,2) - DO i1 = LBOUND(InData%PWaveDynP0,1), UBOUND(InData%PWaveDynP0,1) - ReKiBuf(Re_Xferred) = InData%PWaveDynP0(i1,i2,i3) + DO i3 = LBOUND(InData%WaveDynP0,3), UBOUND(InData%WaveDynP0,3) + DO i2 = LBOUND(InData%WaveDynP0,2), UBOUND(InData%WaveDynP0,2) + DO i1 = LBOUND(InData%WaveDynP0,1), UBOUND(InData%WaveDynP0,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP0(i1,i2,i3) Re_Xferred = Re_Xferred + 1 END DO END DO @@ -13409,7 +11707,7 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%MOutLst,1), UBOUND(InData%MOutLst,1) - CALL Morison_Packmoutput( Re_Buf, Db_Buf, Int_Buf, InData%MOutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! MOutLst + CALL Morison_PackMOutput( Re_Buf, Db_Buf, Int_Buf, InData%MOutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! MOutLst CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13452,7 +11750,7 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%JOutLst,1), UBOUND(InData%JOutLst,1) - CALL Morison_Packjoutput( Re_Buf, Db_Buf, Int_Buf, InData%JOutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! JOutLst + CALL Morison_PackJOutput( Re_Buf, Db_Buf, Int_Buf, InData%JOutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! JOutLst CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13493,7 +11791,7 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13555,7 +11853,7 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ENDIF IntKiBuf(Int_Xferred) = InData%WaveStMod Int_Xferred = Int_Xferred + 1 - CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField + CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13679,7 +11977,7 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Morison_Unpackmembertype( Re_Buf, Db_Buf, Int_Buf, OutData%Members(i1), ErrStat2, ErrMsg2 ) ! Members + CALL Morison_UnpackMemberType( Re_Buf, Db_Buf, Int_Buf, OutData%Members(i1), ErrStat2, ErrMsg2 ) ! Members CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13907,209 +12205,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElev1)) DEALLOCATE(OutData%WaveElev1) - ALLOCATE(OutData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElev1,3), UBOUND(OutData%WaveElev1,3) - DO i2 = LBOUND(OutData%WaveElev1,2), UBOUND(OutData%WaveElev1,2) - DO i1 = LBOUND(OutData%WaveElev1,1), UBOUND(OutData%WaveElev1,1) - OutData%WaveElev1(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElev2)) DEALLOCATE(OutData%WaveElev2) - ALLOCATE(OutData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElev2,3), UBOUND(OutData%WaveElev2,3) - DO i2 = LBOUND(OutData%WaveElev2,2), UBOUND(OutData%WaveElev2,2) - DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) - OutData%WaveElev2(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveVel)) DEALLOCATE(OutData%WaveVel) - ALLOCATE(OutData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveVel,5), UBOUND(OutData%WaveVel,5) - DO i4 = LBOUND(OutData%WaveVel,4), UBOUND(OutData%WaveVel,4) - DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) - DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) - DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) - OutData%WaveVel(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveAcc)) DEALLOCATE(OutData%WaveAcc) - ALLOCATE(OutData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAcc,5), UBOUND(OutData%WaveAcc,5) - DO i4 = LBOUND(OutData%WaveAcc,4), UBOUND(OutData%WaveAcc,4) - DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) - DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) - DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) - OutData%WaveAcc(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAccMCF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveAccMCF)) DEALLOCATE(OutData%WaveAccMCF) - ALLOCATE(OutData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAccMCF,5), UBOUND(OutData%WaveAccMCF,5) - DO i4 = LBOUND(OutData%WaveAccMCF,4), UBOUND(OutData%WaveAccMCF,4) - DO i3 = LBOUND(OutData%WaveAccMCF,3), UBOUND(OutData%WaveAccMCF,3) - DO i2 = LBOUND(OutData%WaveAccMCF,2), UBOUND(OutData%WaveAccMCF,2) - DO i1 = LBOUND(OutData%WaveAccMCF,1), UBOUND(OutData%WaveAccMCF,1) - OutData%WaveAccMCF(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveDynP)) DEALLOCATE(OutData%WaveDynP) - ALLOCATE(OutData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%WaveDynP,4), UBOUND(OutData%WaveDynP,4) - DO i3 = LBOUND(OutData%WaveDynP,3), UBOUND(OutData%WaveDynP,3) - DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) - DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) - OutData%WaveDynP(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF + NULLIFY(OutData%WaveElev1) + NULLIFY(OutData%WaveElev2) + NULLIFY(OutData%WaveVel) + NULLIFY(OutData%WaveAcc) + NULLIFY(OutData%WaveAccMCF) + NULLIFY(OutData%WaveDynP) IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14237,151 +12338,11 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveVel0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveVel0)) DEALLOCATE(OutData%PWaveVel0) - ALLOCATE(OutData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveVel0,4), UBOUND(OutData%PWaveVel0,4) - DO i3 = LBOUND(OutData%PWaveVel0,3), UBOUND(OutData%PWaveVel0,3) - DO i2 = LBOUND(OutData%PWaveVel0,2), UBOUND(OutData%PWaveVel0,2) - DO i1 = LBOUND(OutData%PWaveVel0,1), UBOUND(OutData%PWaveVel0,1) - OutData%PWaveVel0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAcc0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveAcc0)) DEALLOCATE(OutData%PWaveAcc0) - ALLOCATE(OutData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveAcc0,4), UBOUND(OutData%PWaveAcc0,4) - DO i3 = LBOUND(OutData%PWaveAcc0,3), UBOUND(OutData%PWaveAcc0,3) - DO i2 = LBOUND(OutData%PWaveAcc0,2), UBOUND(OutData%PWaveAcc0,2) - DO i1 = LBOUND(OutData%PWaveAcc0,1), UBOUND(OutData%PWaveAcc0,1) - OutData%PWaveAcc0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAccMCF0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveAccMCF0)) DEALLOCATE(OutData%PWaveAccMCF0) - ALLOCATE(OutData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveAccMCF0,4), UBOUND(OutData%PWaveAccMCF0,4) - DO i3 = LBOUND(OutData%PWaveAccMCF0,3), UBOUND(OutData%PWaveAccMCF0,3) - DO i2 = LBOUND(OutData%PWaveAccMCF0,2), UBOUND(OutData%PWaveAccMCF0,2) - DO i1 = LBOUND(OutData%PWaveAccMCF0,1), UBOUND(OutData%PWaveAccMCF0,1) - OutData%PWaveAccMCF0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveDynP0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveDynP0)) DEALLOCATE(OutData%PWaveDynP0) - ALLOCATE(OutData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PWaveDynP0,3), UBOUND(OutData%PWaveDynP0,3) - DO i2 = LBOUND(OutData%PWaveDynP0,2), UBOUND(OutData%PWaveDynP0,2) - DO i1 = LBOUND(OutData%PWaveDynP0,1), UBOUND(OutData%PWaveDynP0,1) - OutData%PWaveDynP0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF + NULLIFY(OutData%WaveTime) + NULLIFY(OutData%PWaveVel0) + NULLIFY(OutData%PWaveAcc0) + NULLIFY(OutData%PWaveAccMCF0) + NULLIFY(OutData%PWaveDynP0) OutData%NStepWave = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%NMOutputs = IntKiBuf(Int_Xferred) @@ -14433,7 +12394,7 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Morison_Unpackmoutput( Re_Buf, Db_Buf, Int_Buf, OutData%MOutLst(i1), ErrStat2, ErrMsg2 ) ! MOutLst + CALL Morison_UnpackMOutput( Re_Buf, Db_Buf, Int_Buf, OutData%MOutLst(i1), ErrStat2, ErrMsg2 ) ! MOutLst CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14491,7 +12452,7 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Morison_Unpackjoutput( Re_Buf, Db_Buf, Int_Buf, OutData%JOutLst(i1), ErrStat2, ErrMsg2 ) ! JOutLst + CALL Morison_UnpackJOutput( Re_Buf, Db_Buf, Int_Buf, OutData%JOutLst(i1), ErrStat2, ErrMsg2 ) ! JOutLst CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14547,7 +12508,7 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14633,7 +12594,7 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SeaSt_WaveField_Unpackseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField + CALL SeaSt_WaveField_UnpackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14661,14 +12622,12 @@ SUBROUTINE Morison_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE Morison_CopyInput - SUBROUTINE Morison_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(Morison_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyInput' @@ -14676,12 +12635,6 @@ SUBROUTINE Morison_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( InputData%Mesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Morison_DestroyInput @@ -14896,14 +12849,12 @@ SUBROUTINE Morison_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ENDIF END SUBROUTINE Morison_CopyOutput - SUBROUTINE Morison_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Morison_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(Morison_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyOutput' @@ -14911,12 +12862,6 @@ SUBROUTINE Morison_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointer ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(OutputData%WriteOutput)) THEN diff --git a/modules/hydrodyn/src/SS_Excitation.f90 b/modules/hydrodyn/src/SS_Excitation.f90 index 32fdc9a9f8..6025527774 100644 --- a/modules/hydrodyn/src/SS_Excitation.f90 +++ b/modules/hydrodyn/src/SS_Excitation.f90 @@ -378,28 +378,28 @@ SUBROUTINE SS_Exc_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ! Place any last minute operations or calculations here: ! Destroy the input data: - CALL SS_Exc_DestroyInput( u, ErrStat, ErrMsg, DEALLOCATEpointers=.false. ) + CALL SS_Exc_DestroyInput( u, ErrStat, ErrMsg ) ! Destroy the parameter data, but don't deallocate SeaState data: ! **** Note, this is called only from the SS Excitation driver code, so there should not be any issues with pointers on restart*** - CALL SS_Exc_DestroyParam( p, ErrStat, ErrMsg, DEALLOCATEpointers=.false. ) + CALL SS_Exc_DestroyParam( p, ErrStat, ErrMsg ) ! Destroy the state data: - CALL SS_Exc_DestroyContState( x, ErrStat, ErrMsg, DEALLOCATEpointers=.false. ) - CALL SS_Exc_DestroyDiscState( xd, ErrStat, ErrMsg, DEALLOCATEpointers=.false. ) - CALL SS_Exc_DestroyConstrState( z, ErrStat, ErrMsg, DEALLOCATEpointers=.false. ) - CALL SS_Exc_DestroyOtherState( OtherState, ErrStat, ErrMsg, DEALLOCATEpointers=.false. ) + CALL SS_Exc_DestroyContState( x, ErrStat, ErrMsg ) + CALL SS_Exc_DestroyDiscState( xd, ErrStat, ErrMsg ) + CALL SS_Exc_DestroyConstrState( z, ErrStat, ErrMsg ) + CALL SS_Exc_DestroyOtherState( OtherState, ErrStat, ErrMsg ) ! Destroy misc vars: - CALL SS_Exc_DestroyMisc( m, ErrStat, ErrMsg, DEALLOCATEpointers=.false. ) + CALL SS_Exc_DestroyMisc( m, ErrStat, ErrMsg ) ! Destroy the output data: - CALL SS_Exc_DestroyOutput( y, ErrStat, ErrMsg, DEALLOCATEpointers=.false. ) + CALL SS_Exc_DestroyOutput( y, ErrStat, ErrMsg ) diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index c3fa1ef85b..7f835f96c8 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -157,47 +157,19 @@ SUBROUTINE SS_Exc_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, E END IF DstInitInputData%WaveElev0 = SrcInitInputData%WaveElev0 ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveElev1)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElev1,1) - i1_u = UBOUND(SrcInitInputData%WaveElev1,1) - i2_l = LBOUND(SrcInitInputData%WaveElev1,2) - i2_u = UBOUND(SrcInitInputData%WaveElev1,2) - i3_l = LBOUND(SrcInitInputData%WaveElev1,3) - i3_u = UBOUND(SrcInitInputData%WaveElev1,3) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveElev1)) THEN - ALLOCATE(DstInitInputData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElev1 = SrcInitInputData%WaveElev1 -ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveTime)) THEN - i1_l = LBOUND(SrcInitInputData%WaveTime,1) - i1_u = UBOUND(SrcInitInputData%WaveTime,1) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveTime)) THEN - ALLOCATE(DstInitInputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveTime = SrcInitInputData%WaveTime -ENDIF + DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 + DstInitInputData%WaveTime => SrcInitInputData%WaveTime CALL SeaSt_Interp_CopyParam( SrcInitInputData%SeaSt_Interp_p, DstInitInputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE SS_Exc_CopyInitInput - SUBROUTINE SS_Exc_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Exc_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(SS_Exc_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyInitInput' @@ -205,29 +177,15 @@ SUBROUTINE SS_Exc_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%PtfmRefztRot)) THEN DEALLOCATE(InitInputData%PtfmRefztRot) ENDIF IF (ALLOCATED(InitInputData%WaveElev0)) THEN DEALLOCATE(InitInputData%WaveElev0) ENDIF -IF (ASSOCIATED(InitInputData%WaveElev1)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveElev1) - InitInputData%WaveElev1 => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%WaveTime)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveTime) - InitInputData%WaveTime => NULL() -ENDIF - CALL SeaSt_Interp_DestroyParam( InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +NULLIFY(InitInputData%WaveElev1) +NULLIFY(InitInputData%WaveTime) + CALL SeaSt_Interp_DestroyParam( InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SS_Exc_DestroyInitInput @@ -280,16 +238,6 @@ SUBROUTINE SS_Exc_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IF ( ALLOCATED(InData%WaveElev0) ) THEN Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev1 allocated yes/no - IF ( ASSOCIATED(InData%WaveElev1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElev1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev1) ! WaveElev1 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ASSOCIATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_p: size of buffers for each call to pack subtype @@ -377,46 +325,6 @@ SUBROUTINE SS_Exc_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) Re_Xferred = Re_Xferred + 1 END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveElev1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElev1,3), UBOUND(InData%WaveElev1,3) - DO i2 = LBOUND(InData%WaveElev1,2), UBOUND(InData%WaveElev1,2) - DO i1 = LBOUND(InData%WaveElev1,1), UBOUND(InData%WaveElev1,1) - ReKiBuf(Re_Xferred) = InData%WaveElev1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO END IF CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -525,52 +433,8 @@ SUBROUTINE SS_Exc_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElev1)) DEALLOCATE(OutData%WaveElev1) - ALLOCATE(OutData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElev1,3), UBOUND(OutData%WaveElev1,3) - DO i2 = LBOUND(OutData%WaveElev1,2), UBOUND(OutData%WaveElev1,2) - DO i1 = LBOUND(OutData%WaveElev1,1), UBOUND(OutData%WaveElev1,1) - OutData%WaveElev1(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF + NULLIFY(OutData%WaveElev1) + NULLIFY(OutData%WaveTime) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -654,14 +518,12 @@ SUBROUTINE SS_Exc_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode ENDIF END SUBROUTINE SS_Exc_CopyInitOutput - SUBROUTINE SS_Exc_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Exc_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(SS_Exc_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyInitOutput' @@ -669,12 +531,6 @@ SUBROUTINE SS_Exc_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) ENDIF @@ -889,14 +745,12 @@ SUBROUTINE SS_Exc_CopyContState( SrcContStateData, DstContStateData, CtrlCode, E ENDIF END SUBROUTINE SS_Exc_CopyContState - SUBROUTINE SS_Exc_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Exc_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(SS_Exc_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyContState' @@ -904,12 +758,6 @@ SUBROUTINE SS_Exc_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ContStateData%x)) THEN DEALLOCATE(ContStateData%x) ENDIF @@ -1063,14 +911,12 @@ SUBROUTINE SS_Exc_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, E DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE SS_Exc_CopyDiscState - SUBROUTINE SS_Exc_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Exc_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(SS_Exc_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyDiscState' @@ -1078,12 +924,6 @@ SUBROUTINE SS_Exc_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SS_Exc_DestroyDiscState SUBROUTINE SS_Exc_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1200,14 +1040,12 @@ SUBROUTINE SS_Exc_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlC DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE SS_Exc_CopyConstrState - SUBROUTINE SS_Exc_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Exc_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(SS_Exc_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyConstrState' @@ -1215,12 +1053,6 @@ SUBROUTINE SS_Exc_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SS_Exc_DestroyConstrState SUBROUTINE SS_Exc_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1343,14 +1175,12 @@ SUBROUTINE SS_Exc_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode ENDDO END SUBROUTINE SS_Exc_CopyOtherState - SUBROUTINE SS_Exc_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Exc_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(SS_Exc_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyOtherState' @@ -1358,14 +1188,8 @@ SUBROUTINE SS_Exc_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL SS_Exc_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SS_Exc_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO END SUBROUTINE SS_Exc_DestroyOtherState @@ -1582,14 +1406,12 @@ SUBROUTINE SS_Exc_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE SS_Exc_CopyMisc - SUBROUTINE SS_Exc_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Exc_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(SS_Exc_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyMisc' @@ -1597,13 +1419,7 @@ SUBROUTINE SS_Exc_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL SeaSt_Interp_DestroyMisc( MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_Interp_DestroyMisc( MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SS_Exc_DestroyMisc @@ -1877,47 +1693,19 @@ SUBROUTINE SS_Exc_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM END IF DstParamData%WaveElev0 = SrcParamData%WaveElev0 ENDIF -IF (ASSOCIATED(SrcParamData%WaveElev1)) THEN - i1_l = LBOUND(SrcParamData%WaveElev1,1) - i1_u = UBOUND(SrcParamData%WaveElev1,1) - i2_l = LBOUND(SrcParamData%WaveElev1,2) - i2_u = UBOUND(SrcParamData%WaveElev1,2) - i3_l = LBOUND(SrcParamData%WaveElev1,3) - i3_u = UBOUND(SrcParamData%WaveElev1,3) - IF (.NOT. ASSOCIATED(DstParamData%WaveElev1)) THEN - ALLOCATE(DstParamData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveElev1 = SrcParamData%WaveElev1 -ENDIF -IF (ASSOCIATED(SrcParamData%WaveTime)) THEN - i1_l = LBOUND(SrcParamData%WaveTime,1) - i1_u = UBOUND(SrcParamData%WaveTime,1) - IF (.NOT. ASSOCIATED(DstParamData%WaveTime)) THEN - ALLOCATE(DstParamData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveTime = SrcParamData%WaveTime -ENDIF + DstParamData%WaveElev1 => SrcParamData%WaveElev1 + DstParamData%WaveTime => SrcParamData%WaveTime CALL SeaSt_Interp_CopyParam( SrcParamData%SeaSt_Interp_p, DstParamData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE SS_Exc_CopyParam - SUBROUTINE SS_Exc_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Exc_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(SS_Exc_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyParam' @@ -1925,12 +1713,6 @@ SUBROUTINE SS_Exc_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%spDOF)) THEN DEALLOCATE(ParamData%spDOF) ENDIF @@ -1946,17 +1728,9 @@ SUBROUTINE SS_Exc_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(ParamData%WaveElev0)) THEN DEALLOCATE(ParamData%WaveElev0) ENDIF -IF (ASSOCIATED(ParamData%WaveElev1)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%WaveElev1) - ParamData%WaveElev1 => NULL() -ENDIF -IF (ASSOCIATED(ParamData%WaveTime)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%WaveTime) - ParamData%WaveTime => NULL() -ENDIF - CALL SeaSt_Interp_DestroyParam( ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +NULLIFY(ParamData%WaveElev1) +NULLIFY(ParamData%WaveTime) + CALL SeaSt_Interp_DestroyParam( ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SS_Exc_DestroyParam @@ -2025,16 +1799,6 @@ SUBROUTINE SS_Exc_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IF ( ALLOCATED(InData%WaveElev0) ) THEN Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev1 allocated yes/no - IF ( ASSOCIATED(InData%WaveElev1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElev1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev1) ! WaveElev1 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ASSOCIATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_p: size of buffers for each call to pack subtype @@ -2177,46 +1941,6 @@ SUBROUTINE SS_Exc_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) Re_Xferred = Re_Xferred + 1 END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveElev1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElev1,3), UBOUND(InData%WaveElev1,3) - DO i2 = LBOUND(InData%WaveElev1,2), UBOUND(InData%WaveElev1,2) - DO i1 = LBOUND(InData%WaveElev1,1), UBOUND(InData%WaveElev1,1) - ReKiBuf(Re_Xferred) = InData%WaveElev1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO END IF CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2389,52 +2113,8 @@ SUBROUTINE SS_Exc_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElev1)) DEALLOCATE(OutData%WaveElev1) - ALLOCATE(OutData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElev1,3), UBOUND(OutData%WaveElev1,3) - DO i2 = LBOUND(OutData%WaveElev1,2), UBOUND(OutData%WaveElev1,2) - DO i1 = LBOUND(OutData%WaveElev1,1), UBOUND(OutData%WaveElev1,1) - OutData%WaveElev1(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF + NULLIFY(OutData%WaveElev1) + NULLIFY(OutData%WaveTime) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -2509,14 +2189,12 @@ SUBROUTINE SS_Exc_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM ENDIF END SUBROUTINE SS_Exc_CopyInput - SUBROUTINE SS_Exc_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Exc_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(SS_Exc_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyInput' @@ -2524,12 +2202,6 @@ SUBROUTINE SS_Exc_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputData%PtfmPos)) THEN DEALLOCATE(InputData%PtfmPos) ENDIF @@ -2718,14 +2390,12 @@ SUBROUTINE SS_Exc_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, E ENDIF END SUBROUTINE SS_Exc_CopyOutput - SUBROUTINE SS_Exc_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Exc_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(SS_Exc_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyOutput' @@ -2733,12 +2403,6 @@ SUBROUTINE SS_Exc_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%y)) THEN DEALLOCATE(OutputData%y) ENDIF diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index dcea3022a3..24ba2c23a5 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -105,7 +105,6 @@ SUBROUTINE SS_Rad_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, E ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_CopyInitInput' @@ -140,14 +139,12 @@ SUBROUTINE SS_Rad_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, E ENDIF END SUBROUTINE SS_Rad_CopyInitInput - SUBROUTINE SS_Rad_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Rad_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(SS_Rad_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyInitInput' @@ -155,12 +152,6 @@ SUBROUTINE SS_Rad_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%enabledDOFs)) THEN DEALLOCATE(InitInputData%enabledDOFs) ENDIF @@ -295,7 +286,6 @@ SUBROUTINE SS_Rad_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackInitInput' @@ -394,14 +384,12 @@ SUBROUTINE SS_Rad_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode ENDIF END SUBROUTINE SS_Rad_CopyInitOutput - SUBROUTINE SS_Rad_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Rad_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(SS_Rad_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyInitOutput' @@ -409,12 +397,6 @@ SUBROUTINE SS_Rad_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) ENDIF @@ -629,14 +611,12 @@ SUBROUTINE SS_Rad_CopyContState( SrcContStateData, DstContStateData, CtrlCode, E ENDIF END SUBROUTINE SS_Rad_CopyContState - SUBROUTINE SS_Rad_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Rad_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(SS_Rad_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyContState' @@ -644,12 +624,6 @@ SUBROUTINE SS_Rad_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ContStateData%x)) THEN DEALLOCATE(ContStateData%x) ENDIF @@ -803,14 +777,12 @@ SUBROUTINE SS_Rad_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, E DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE SS_Rad_CopyDiscState - SUBROUTINE SS_Rad_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Rad_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(SS_Rad_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyDiscState' @@ -818,12 +790,6 @@ SUBROUTINE SS_Rad_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SS_Rad_DestroyDiscState SUBROUTINE SS_Rad_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -940,14 +906,12 @@ SUBROUTINE SS_Rad_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlC DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE SS_Rad_CopyConstrState - SUBROUTINE SS_Rad_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Rad_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(SS_Rad_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyConstrState' @@ -955,12 +919,6 @@ SUBROUTINE SS_Rad_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SS_Rad_DestroyConstrState SUBROUTINE SS_Rad_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1083,14 +1041,12 @@ SUBROUTINE SS_Rad_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode ENDDO END SUBROUTINE SS_Rad_CopyOtherState - SUBROUTINE SS_Rad_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Rad_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(SS_Rad_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyOtherState' @@ -1098,14 +1054,8 @@ SUBROUTINE SS_Rad_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL SS_Rad_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SS_Rad_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO END SUBROUTINE SS_Rad_DestroyOtherState @@ -1319,14 +1269,12 @@ SUBROUTINE SS_Rad_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar END SUBROUTINE SS_Rad_CopyMisc - SUBROUTINE SS_Rad_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Rad_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(SS_Rad_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyMisc' @@ -1334,12 +1282,6 @@ SUBROUTINE SS_Rad_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SS_Rad_DestroyMisc SUBROUTINE SS_Rad_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1514,14 +1456,12 @@ SUBROUTINE SS_Rad_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%NBody = SrcParamData%NBody END SUBROUTINE SS_Rad_CopyParam - SUBROUTINE SS_Rad_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Rad_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(SS_Rad_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyParam' @@ -1529,12 +1469,6 @@ SUBROUTINE SS_Rad_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%A)) THEN DEALLOCATE(ParamData%A) ENDIF @@ -1869,14 +1803,12 @@ SUBROUTINE SS_Rad_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM ENDIF END SUBROUTINE SS_Rad_CopyInput - SUBROUTINE SS_Rad_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Rad_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(SS_Rad_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyInput' @@ -1884,12 +1816,6 @@ SUBROUTINE SS_Rad_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputData%dq)) THEN DEALLOCATE(InputData%dq) ENDIF @@ -2067,14 +1993,12 @@ SUBROUTINE SS_Rad_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, E ENDIF END SUBROUTINE SS_Rad_CopyOutput - SUBROUTINE SS_Rad_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SS_Rad_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(SS_Rad_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyOutput' @@ -2082,12 +2006,6 @@ SUBROUTINE SS_Rad_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%y)) THEN DEALLOCATE(OutputData%y) ENDIF diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index 7579ab7e32..97a09cdeb8 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -1533,13 +1533,13 @@ SUBROUTINE Cleanup() ! destroy local variables that are types in the framework: - CALL Conv_Rdtn_DestroyInitInput( Conv_Rdtn_InitInp, ErrStat2, ErrMsg2, DEALLOCATEpointers=.false. ) - CALL Conv_Rdtn_DestroyInitOutput( Conv_Rdtn_InitOut, ErrStat2, ErrMsg2, DEALLOCATEpointers=.false. ) + CALL Conv_Rdtn_DestroyInitInput( Conv_Rdtn_InitInp, ErrStat2, ErrMsg2 ) + CALL Conv_Rdtn_DestroyInitOutput( Conv_Rdtn_InitOut, ErrStat2, ErrMsg2 ) - CALL SS_Rad_DestroyInitInput( SS_Rdtn_InitInp, ErrStat2, ErrMsg2, DEALLOCATEpointers=.false. ) - CALL SS_Rad_DestroyInitOutput( SS_Rdtn_InitOut, ErrStat2, ErrMsg2, DEALLOCATEpointers=.false. ) - CALL SS_Exc_DestroyInitInput( SS_Exctn_InitInp, ErrStat2, ErrMsg2, DEALLOCATEpointers=.false. ) - CALL SS_Exc_DestroyInitOutput( SS_Exctn_InitOut, ErrStat2, ErrMsg2, DEALLOCATEpointers=.false. ) + CALL SS_Rad_DestroyInitInput( SS_Rdtn_InitInp, ErrStat2, ErrMsg2 ) + CALL SS_Rad_DestroyInitOutput( SS_Rdtn_InitOut, ErrStat2, ErrMsg2 ) + CALL SS_Exc_DestroyInitInput( SS_Exctn_InitInp, ErrStat2, ErrMsg2 ) + CALL SS_Exc_DestroyInitOutput( SS_Exctn_InitOut, ErrStat2, ErrMsg2 ) ! destroy local variables that are allocatable arrays: @@ -1599,7 +1599,7 @@ SUBROUTINE WAMIT_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ! Destroy the parameter data: - CALL WAMIT_DestroyParam( p, ErrStat, ErrMsg, DEALLOCATEpointers=.false. ) + CALL WAMIT_DestroyParam( p, ErrStat, ErrMsg ) ! Destroy the state data: diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 2e202905c4..c25f669f91 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -179,34 +179,10 @@ SUBROUTINE WAMIT2_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%WtrDens = SrcInitInputData%WtrDens DstInitInputData%Gravity = SrcInitInputData%Gravity DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth -IF (ASSOCIATED(SrcInitInputData%WaveElevC0)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevC0,1) - i1_u = UBOUND(SrcInitInputData%WaveElevC0,1) - i2_l = LBOUND(SrcInitInputData%WaveElevC0,2) - i2_u = UBOUND(SrcInitInputData%WaveElevC0,2) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveElevC0)) THEN - ALLOCATE(DstInitInputData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevC0 = SrcInitInputData%WaveElevC0 -ENDIF + DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 DstInitInputData%WaveDir = SrcInitInputData%WaveDir DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir -IF (ASSOCIATED(SrcInitInputData%WaveDirArr)) THEN - i1_l = LBOUND(SrcInitInputData%WaveDirArr,1) - i1_u = UBOUND(SrcInitInputData%WaveDirArr,1) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveDirArr)) THEN - ALLOCATE(DstInitInputData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveDirArr = SrcInitInputData%WaveDirArr -ENDIF + DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax DstInitInputData%WaveMod = SrcInitInputData%WaveMod @@ -226,14 +202,12 @@ SUBROUTINE WAMIT2_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS END SUBROUTINE WAMIT2_CopyInitInput - SUBROUTINE WAMIT2_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WAMIT2_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(WAMIT2_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyInitInput' @@ -241,12 +215,6 @@ SUBROUTINE WAMIT2_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%PtfmRefxt)) THEN DEALLOCATE(InitInputData%PtfmRefxt) ENDIF @@ -259,16 +227,8 @@ SUBROUTINE WAMIT2_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpo IF (ALLOCATED(InitInputData%PtfmRefztRot)) THEN DEALLOCATE(InitInputData%PtfmRefztRot) ENDIF -IF (ASSOCIATED(InitInputData%WaveElevC0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveElevC0) - InitInputData%WaveElevC0 => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%WaveDirArr)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveDirArr) - InitInputData%WaveDirArr => NULL() -ENDIF +NULLIFY(InitInputData%WaveElevC0) +NULLIFY(InitInputData%WaveDirArr) END SUBROUTINE WAMIT2_DestroyInitInput SUBROUTINE WAMIT2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -338,18 +298,8 @@ SUBROUTINE WAMIT2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Re_BufSz = Re_BufSz + 1 ! WtrDens Re_BufSz = Re_BufSz + 1 ! Gravity Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! WaveElevC0 allocated yes/no - IF ( ASSOCIATED(InData%WaveElevC0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevC0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC0) ! WaveElevC0 - END IF Re_BufSz = Re_BufSz + 1 ! WaveDir Int_BufSz = Int_BufSz + 1 ! WaveMultiDir - Int_BufSz = Int_BufSz + 1 ! WaveDirArr allocated yes/no - IF ( ASSOCIATED(InData%WaveDirArr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveDirArr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDirArr) ! WaveDirArr - END IF Re_BufSz = Re_BufSz + 1 ! WaveDirMin Re_BufSz = Re_BufSz + 1 ! WaveDirMax Int_BufSz = Int_BufSz + 1 ! WaveMod @@ -480,45 +430,10 @@ SUBROUTINE WAMIT2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%WtrDpth Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ASSOCIATED(InData%WaveElevC0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) - DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF ReKiBuf(Re_Xferred) = InData%WaveDir Re_Xferred = Re_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ASSOCIATED(InData%WaveDirArr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDirArr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) - ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF ReKiBuf(Re_Xferred) = InData%WaveDirMin Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%WaveDirMax @@ -681,51 +596,12 @@ SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = Re_Xferred + 1 OutData%WtrDpth = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElevC0)) DEALLOCATE(OutData%WaveElevC0) - ALLOCATE(OutData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) - DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) - OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF + NULLIFY(OutData%WaveElevC0) OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) Re_Xferred = Re_Xferred + 1 OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveDirArr)) DEALLOCATE(OutData%WaveDirArr) - ALLOCATE(OutData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) - OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF + NULLIFY(OutData%WaveDirArr) OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) Re_Xferred = Re_Xferred + 1 OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) @@ -803,14 +679,12 @@ SUBROUTINE WAMIT2_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE WAMIT2_CopyMisc - SUBROUTINE WAMIT2_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WAMIT2_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(WAMIT2_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyMisc' @@ -818,12 +692,6 @@ SUBROUTINE WAMIT2_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MiscData%LastIndWave)) THEN DEALLOCATE(MiscData%LastIndWave) ENDIF @@ -1044,14 +912,12 @@ SUBROUTINE WAMIT2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%SumQTFF = SrcParamData%SumQTFF END SUBROUTINE WAMIT2_CopyParam - SUBROUTINE WAMIT2_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WAMIT2_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(WAMIT2_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyParam' @@ -1059,12 +925,6 @@ SUBROUTINE WAMIT2_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%WaveExctn2)) THEN DEALLOCATE(ParamData%WaveExctn2) ENDIF @@ -1310,14 +1170,12 @@ SUBROUTINE WAMIT2_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, E IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT2_CopyOutput - SUBROUTINE WAMIT2_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WAMIT2_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(WAMIT2_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyOutput' @@ -1325,12 +1183,6 @@ SUBROUTINE WAMIT2_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WAMIT2_DestroyOutput diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 863606d744..bbc2522890 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -33,7 +33,6 @@ MODULE WAMIT_Types !--------------------------------------------------------------------------------------------------------------------------------- USE Conv_Radiation_Types USE SS_Radiation_Types -USE SeaState_Interp_Types USE SS_Excitation_Types USE NWTC_Library IMPLICIT NONE @@ -169,7 +168,6 @@ SUBROUTINE WAMIT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_CopyInitInput' @@ -292,36 +290,8 @@ SUBROUTINE WAMIT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er END IF DstInitInputData%WaveElev0 = SrcInitInputData%WaveElev0 ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveElev1)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElev1,1) - i1_u = UBOUND(SrcInitInputData%WaveElev1,1) - i2_l = LBOUND(SrcInitInputData%WaveElev1,2) - i2_u = UBOUND(SrcInitInputData%WaveElev1,2) - i3_l = LBOUND(SrcInitInputData%WaveElev1,3) - i3_u = UBOUND(SrcInitInputData%WaveElev1,3) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveElev1)) THEN - ALLOCATE(DstInitInputData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElev1 = SrcInitInputData%WaveElev1 -ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveElevC0)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevC0,1) - i1_u = UBOUND(SrcInitInputData%WaveElevC0,1) - i2_l = LBOUND(SrcInitInputData%WaveElevC0,2) - i2_u = UBOUND(SrcInitInputData%WaveElevC0,2) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveElevC0)) THEN - ALLOCATE(DstInitInputData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevC0 = SrcInitInputData%WaveElevC0 -ENDIF + DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 + DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 IF (ALLOCATED(SrcInitInputData%WaveElevC)) THEN i1_l = LBOUND(SrcInitInputData%WaveElevC,1) i1_u = UBOUND(SrcInitInputData%WaveElevC,1) @@ -338,32 +308,10 @@ SUBROUTINE WAMIT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er END IF DstInitInputData%WaveElevC = SrcInitInputData%WaveElevC ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveTime)) THEN - i1_l = LBOUND(SrcInitInputData%WaveTime,1) - i1_u = UBOUND(SrcInitInputData%WaveTime,1) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveTime)) THEN - ALLOCATE(DstInitInputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveTime = SrcInitInputData%WaveTime -ENDIF + DstInitInputData%WaveTime => SrcInitInputData%WaveTime DstInitInputData%WaveMod = SrcInitInputData%WaveMod DstInitInputData%WtrDens = SrcInitInputData%WtrDens -IF (ASSOCIATED(SrcInitInputData%WaveDirArr)) THEN - i1_l = LBOUND(SrcInitInputData%WaveDirArr,1) - i1_u = UBOUND(SrcInitInputData%WaveDirArr,1) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveDirArr)) THEN - ALLOCATE(DstInitInputData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveDirArr = SrcInitInputData%WaveDirArr -ENDIF + DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax CALL SeaSt_Interp_CopyParam( SrcInitInputData%SeaSt_Interp_p, DstInitInputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) @@ -371,14 +319,12 @@ SUBROUTINE WAMIT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT_CopyInitInput - SUBROUTINE WAMIT_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WAMIT_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(WAMIT_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyInitInput' @@ -386,12 +332,6 @@ SUBROUTINE WAMIT_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%PtfmVol0)) THEN DEALLOCATE(InitInputData%PtfmVol0) ENDIF @@ -413,35 +353,19 @@ SUBROUTINE WAMIT_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoi IF (ALLOCATED(InitInputData%PtfmCOByt)) THEN DEALLOCATE(InitInputData%PtfmCOByt) ENDIF - CALL Conv_Rdtn_DestroyInitInput( InitInputData%Conv_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Conv_Rdtn_DestroyInitInput( InitInputData%Conv_Rdtn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitInputData%WaveElev0)) THEN DEALLOCATE(InitInputData%WaveElev0) ENDIF -IF (ASSOCIATED(InitInputData%WaveElev1)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveElev1) - InitInputData%WaveElev1 => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%WaveElevC0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveElevC0) - InitInputData%WaveElevC0 => NULL() -ENDIF +NULLIFY(InitInputData%WaveElev1) +NULLIFY(InitInputData%WaveElevC0) IF (ALLOCATED(InitInputData%WaveElevC)) THEN DEALLOCATE(InitInputData%WaveElevC) ENDIF -IF (ASSOCIATED(InitInputData%WaveTime)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveTime) - InitInputData%WaveTime => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%WaveDirArr)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveDirArr) - InitInputData%WaveDirArr => NULL() -ENDIF - CALL SeaSt_Interp_DestroyParam( InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +NULLIFY(InitInputData%WaveTime) +NULLIFY(InitInputData%WaveDirArr) + CALL SeaSt_Interp_DestroyParam( InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WAMIT_DestroyInitInput @@ -555,33 +479,13 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev1 allocated yes/no - IF ( ASSOCIATED(InData%WaveElev1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElev1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev1) ! WaveElev1 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevC0 allocated yes/no - IF ( ASSOCIATED(InData%WaveElevC0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevC0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC0) ! WaveElevC0 - END IF Int_BufSz = Int_BufSz + 1 ! WaveElevC allocated yes/no IF ( ALLOCATED(InData%WaveElevC) ) THEN Int_BufSz = Int_BufSz + 2*3 ! WaveElevC upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC) ! WaveElevC - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ASSOCIATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime END IF Int_BufSz = Int_BufSz + 1 ! WaveMod Re_BufSz = Re_BufSz + 1 ! WtrDens - Int_BufSz = Int_BufSz + 1 ! WaveDirArr allocated yes/no - IF ( ASSOCIATED(InData%WaveDirArr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveDirArr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDirArr) ! WaveDirArr - END IF Re_BufSz = Re_BufSz + 1 ! WaveDirMin Re_BufSz = Re_BufSz + 1 ! WaveDirMax Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_p: size of buffers for each call to pack subtype @@ -812,51 +716,6 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( .NOT. ASSOCIATED(InData%WaveElev1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElev1,3), UBOUND(InData%WaveElev1,3) - DO i2 = LBOUND(InData%WaveElev1,2), UBOUND(InData%WaveElev1,2) - DO i1 = LBOUND(InData%WaveElev1,1), UBOUND(InData%WaveElev1,1) - ReKiBuf(Re_Xferred) = InData%WaveElev1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveElevC0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) - DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF IF ( .NOT. ALLOCATED(InData%WaveElevC) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -881,41 +740,11 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err END DO END DO END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO END IF IntKiBuf(Int_Xferred) = InData%WaveMod Int_Xferred = Int_Xferred + 1 ReKiBuf(Re_Xferred) = InData%WtrDens Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ASSOCIATED(InData%WaveDirArr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDirArr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) - ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF ReKiBuf(Re_Xferred) = InData%WaveDirMin Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%WaveDirMax @@ -966,7 +795,6 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackInitInput' @@ -1200,57 +1028,8 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElev1)) DEALLOCATE(OutData%WaveElev1) - ALLOCATE(OutData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElev1,3), UBOUND(OutData%WaveElev1,3) - DO i2 = LBOUND(OutData%WaveElev1,2), UBOUND(OutData%WaveElev1,2) - DO i1 = LBOUND(OutData%WaveElev1,1), UBOUND(OutData%WaveElev1,1) - OutData%WaveElev1(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElevC0)) DEALLOCATE(OutData%WaveElevC0) - ALLOCATE(OutData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) - DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) - OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF + NULLIFY(OutData%WaveElev1) + NULLIFY(OutData%WaveElevC0) IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1279,46 +1058,12 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF + NULLIFY(OutData%WaveTime) OutData%WaveMod = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%WtrDens = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveDirArr)) DEALLOCATE(OutData%WaveDirArr) - ALLOCATE(OutData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) - OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF + NULLIFY(OutData%WaveDirArr) OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) Re_Xferred = Re_Xferred + 1 OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) @@ -1390,14 +1135,12 @@ SUBROUTINE WAMIT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Er IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT_CopyContState - SUBROUTINE WAMIT_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WAMIT_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(WAMIT_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyContState' @@ -1405,17 +1148,11 @@ SUBROUTINE WAMIT_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL SS_Rad_DestroyContState( ContStateData%SS_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SS_Rad_DestroyContState( ContStateData%SS_Rdtn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyContState( ContStateData%SS_Exctn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SS_Exc_DestroyContState( ContStateData%SS_Exctn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Conv_Rdtn_DestroyContState( ContStateData%Conv_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Conv_Rdtn_DestroyContState( ContStateData%Conv_Rdtn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WAMIT_DestroyContState @@ -1811,14 +1548,12 @@ SUBROUTINE WAMIT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Er ENDIF END SUBROUTINE WAMIT_CopyDiscState - SUBROUTINE WAMIT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WAMIT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(WAMIT_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyDiscState' @@ -1826,17 +1561,11 @@ SUBROUTINE WAMIT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL Conv_Rdtn_DestroyDiscState( DiscStateData%Conv_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Conv_Rdtn_DestroyDiscState( DiscStateData%Conv_Rdtn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Rad_DestroyDiscState( DiscStateData%SS_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SS_Rad_DestroyDiscState( DiscStateData%SS_Rdtn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyDiscState( DiscStateData%SS_Exctn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SS_Exc_DestroyDiscState( DiscStateData%SS_Exctn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(DiscStateData%BdyPosFilt)) THEN DEALLOCATE(DiscStateData%BdyPosFilt) @@ -2277,14 +2006,12 @@ SUBROUTINE WAMIT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCo IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT_CopyConstrState - SUBROUTINE WAMIT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WAMIT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(WAMIT_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyConstrState' @@ -2292,17 +2019,11 @@ SUBROUTINE WAMIT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCAT ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL Conv_Rdtn_DestroyConstrState( ConstrStateData%Conv_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Conv_Rdtn_DestroyConstrState( ConstrStateData%Conv_Rdtn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Rad_DestroyConstrState( ConstrStateData%SS_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SS_Rad_DestroyConstrState( ConstrStateData%SS_Rdtn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyConstrState( ConstrStateData%SS_Exctn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SS_Exc_DestroyConstrState( ConstrStateData%SS_Exctn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WAMIT_DestroyConstrState @@ -2679,14 +2400,12 @@ SUBROUTINE WAMIT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT_CopyOtherState - SUBROUTINE WAMIT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WAMIT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(WAMIT_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyOtherState' @@ -2694,17 +2413,11 @@ SUBROUTINE WAMIT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL SS_Rad_DestroyOtherState( OtherStateData%SS_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SS_Rad_DestroyOtherState( OtherStateData%SS_Rdtn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyOtherState( OtherStateData%SS_Exctn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SS_Exc_DestroyOtherState( OtherStateData%SS_Exctn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Conv_Rdtn_DestroyOtherState( OtherStateData%Conv_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Conv_Rdtn_DestroyOtherState( OtherStateData%Conv_Rdtn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WAMIT_DestroyOtherState @@ -3152,14 +2865,12 @@ SUBROUTINE WAMIT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT_CopyMisc - SUBROUTINE WAMIT_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WAMIT_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(WAMIT_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyMisc' @@ -3167,12 +2878,6 @@ SUBROUTINE WAMIT_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MiscData%F_HS)) THEN DEALLOCATE(MiscData%F_HS) ENDIF @@ -3185,25 +2890,25 @@ SUBROUTINE WAMIT_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(MiscData%F_PtfmAM)) THEN DEALLOCATE(MiscData%F_PtfmAM) ENDIF - CALL SS_Rad_DestroyMisc( MiscData%SS_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SS_Rad_DestroyMisc( MiscData%SS_Rdtn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Rad_DestroyInput( MiscData%SS_Rdtn_u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SS_Rad_DestroyInput( MiscData%SS_Rdtn_u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Rad_DestroyOutput( MiscData%SS_Rdtn_y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SS_Rad_DestroyOutput( MiscData%SS_Rdtn_y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyMisc( MiscData%SS_Exctn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SS_Exc_DestroyMisc( MiscData%SS_Exctn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyInput( MiscData%SS_Exctn_u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SS_Exc_DestroyInput( MiscData%SS_Exctn_u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyOutput( MiscData%SS_Exctn_y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SS_Exc_DestroyOutput( MiscData%SS_Exctn_y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Conv_Rdtn_DestroyMisc( MiscData%Conv_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Conv_Rdtn_DestroyMisc( MiscData%Conv_Rdtn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Conv_Rdtn_DestroyInput( MiscData%Conv_Rdtn_u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Conv_Rdtn_DestroyInput( MiscData%Conv_Rdtn_u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Conv_Rdtn_DestroyOutput( MiscData%Conv_Rdtn_y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + 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, DEALLOCATEpointers_local ) + CALL SeaSt_Interp_DestroyMisc( MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WAMIT_DestroyMisc @@ -4423,14 +4128,12 @@ SUBROUTINE WAMIT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT_CopyParam - SUBROUTINE WAMIT_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WAMIT_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(WAMIT_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyParam' @@ -4438,12 +4141,6 @@ SUBROUTINE WAMIT_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%F_HS_Moment_Offset)) THEN DEALLOCATE(ParamData%F_HS_Moment_Offset) ENDIF @@ -4459,13 +4156,13 @@ SUBROUTINE WAMIT_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(ParamData%WaveExctnGrid)) THEN DEALLOCATE(ParamData%WaveExctnGrid) ENDIF - CALL Conv_Rdtn_DestroyParam( ParamData%Conv_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Conv_Rdtn_DestroyParam( ParamData%Conv_Rdtn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Rad_DestroyParam( ParamData%SS_Rdtn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SS_Rad_DestroyParam( ParamData%SS_Rdtn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyParam( ParamData%SS_Exctn, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SS_Exc_DestroyParam( ParamData%SS_Exctn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_Interp_DestroyParam( ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_Interp_DestroyParam( ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WAMIT_DestroyParam @@ -5230,14 +4927,12 @@ SUBROUTINE WAMIT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT_CopyInput - SUBROUTINE WAMIT_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WAMIT_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(WAMIT_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyInput' @@ -5245,12 +4940,6 @@ SUBROUTINE WAMIT_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( InputData%Mesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WAMIT_DestroyInput @@ -5452,14 +5141,12 @@ SUBROUTINE WAMIT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WAMIT_CopyOutput - SUBROUTINE WAMIT_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WAMIT_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(WAMIT_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyOutput' @@ -5467,12 +5154,6 @@ SUBROUTINE WAMIT_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WAMIT_DestroyOutput diff --git a/modules/hydrodyn/src/Waves2_Types.f90 b/modules/hydrodyn/src/Waves2_Types.f90 new file mode 100644 index 0000000000..1a50ae31dd --- /dev/null +++ b/modules/hydrodyn/src/Waves2_Types.f90 @@ -0,0 +1,3841 @@ +!STARTOFREGISTRYGENERATEDFILE 'Waves2_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 +!********************************************************************************************************************************* +! Waves2_Types +!................................................................................................................................. +! This file is part of Waves2. +! +! 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 Waves2. 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 Waves2_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: MaxWaves2Outputs = 9 ! [-] +! ========= Waves2_InitInputType ======= + TYPE, PUBLIC :: Waves2_InitInputType + INTEGER(IntKi) :: UnSum !< The unit number for the HydroDyn summary file [-] + REAL(ReKi) :: Gravity !< Gravitational acceleration [(m/s^2)] + REAL(ReKi) :: WtrDens !< Water density [(kg/m^3)] + REAL(SiKi) :: WtrDpth !< Water depth [(meters)] + INTEGER(IntKi) :: NStepWave !< Total number of frequency components = total number of time steps in the incident wave [-] + INTEGER(IntKi) :: NStepWave2 !< NStepWave / 2 [-] + REAL(SiKi) :: WaveDOmega !< Frequency step for incident wave calculations [(rad/s)] + INTEGER(IntKi) :: WaveStMod !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] + LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveDirArr !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevC0 !< Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Simulation times at which the instantaneous second order loads associated with the incident waves are determined [sec] + INTEGER(IntKi) :: NWaveElev !< Number of points where the incident wave elevations can be output [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevxi !< xi-coordinates for points where the incident wave elevations can be output [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevyi !< yi-coordinates for points where the incident wave elevations can be output [(meters)] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevXY !< Supplied by Driver: X-Y locations for WaveElevation output (for visualization). Index 1 corresponds to X or Y coordinate. Index 2 corresponds to point number. [-] + INTEGER(IntKi) :: NWaveKin !< Number of points where the incident wave kinematics will be computed [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinyi !< yi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinzi !< zi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] + LOGICAL :: WvDiffQTFF !< Full difference QTF second order forces flag [(-)] + LOGICAL :: WvSumQTFF !< Full sum QTF second order forces flag [(-)] + REAL(SiKi) :: WvLowCOffD !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffD !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvLowCOffS !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffS !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + CHARACTER(ChanLen) , DIMENSION(1:18) :: OutList !< This should really be dimensioned with MaxOutPts [-] + LOGICAL :: OutAll !< [-] + INTEGER(IntKi) :: NumOuts !< [-] + INTEGER(IntKi) :: NumOutAll !< [-] + END TYPE Waves2_InitInputType +! ======================= +! ========= Waves2_InitOutputType ======= + TYPE, PUBLIC :: Waves2_InitOutputType + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< [-] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevSeries2 !< [(m)] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc2D !< [(m/s^2)] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP2D !< [(N/m^2)] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc2S !< [(m/s^2)] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP2S !< [(N/m^2)] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel2D !< [(m/s)] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel2S !< [(m/s)] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc2D0 !< [(m/s^2)] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP2D0 !< [(N/m^2)] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc2S0 !< [(m/s^2)] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP2S0 !< [(N/m^2)] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel2D0 !< [(m/s)] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel2S0 !< [(m/s)] + END TYPE Waves2_InitOutputType +! ======================= +! ========= Waves2_ContinuousStateType ======= + TYPE, PUBLIC :: Waves2_ContinuousStateType + REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] + END TYPE Waves2_ContinuousStateType +! ======================= +! ========= Waves2_DiscreteStateType ======= + TYPE, PUBLIC :: Waves2_DiscreteStateType + REAL(SiKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + END TYPE Waves2_DiscreteStateType +! ======================= +! ========= Waves2_ConstraintStateType ======= + TYPE, PUBLIC :: Waves2_ConstraintStateType + REAL(SiKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + END TYPE Waves2_ConstraintStateType +! ======================= +! ========= Waves2_OtherStateType ======= + TYPE, PUBLIC :: Waves2_OtherStateType + INTEGER(IntKi) :: DummyOtherState !< Remove this variable if you have other states [-] + END TYPE Waves2_OtherStateType +! ======================= +! ========= Waves2_MiscVarType ======= + TYPE, PUBLIC :: Waves2_MiscVarType + INTEGER(IntKi) :: LastIndWave !< Index for last interpolation step of 2nd order forces [-] + END TYPE Waves2_MiscVarType +! ======================= +! ========= Waves2_ParameterType ======= + TYPE, PUBLIC :: Waves2_ParameterType + REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] + LOGICAL :: WvDiffQTFF !< Full difference QTF second order forces flag [(-)] + LOGICAL :: WvSumQTFF !< Full sum QTF second order forces flag [(-)] + INTEGER(IntKi) :: NWaveElev !< Number of points where the incident wave elevations can be output [-] + INTEGER(IntKi) :: NStepWave !< Total number of frequency components = total number of time steps in the incident wave [-] + INTEGER(IntKi) :: NStepWave2 !< NStepWave / 2 [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Simulation times at which the instantaneous second order loads associated with the incident waves are determined [sec] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev2 !< Instantaneous elevation time-series of incident waves at each of the NWaveElev points where the incident wave elevations can be output [(meters)] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] + INTEGER(IntKi) :: NumOuts !< [-] + INTEGER(IntKi) :: NumOutAll !< [-] + CHARACTER(20) :: OutFmt !< [-] + CHARACTER(20) :: OutSFmt !< [-] + CHARACTER(ChanLen) :: Delim !< [-] + INTEGER(IntKi) :: UnOutFile !< [-] + END TYPE Waves2_ParameterType +! ======================= +! ========= Waves2_InputType ======= + TYPE, PUBLIC :: Waves2_InputType + REAL(SiKi) :: DummyInput !< Remove this variable if you have input data [-] + END TYPE Waves2_InputType +! ======================= +! ========= Waves2_OutputType ======= + TYPE, PUBLIC :: Waves2_OutputType + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< [-] + END TYPE Waves2_OutputType +! ======================= +CONTAINS + SUBROUTINE Waves2_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves2_InitInputType), INTENT(IN) :: SrcInitInputData + TYPE(Waves2_InitInputType), INTENT(INOUT) :: DstInitInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyInitInput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInitInputData%UnSum = SrcInitInputData%UnSum + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%WtrDens = SrcInitInputData%WtrDens + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%NStepWave = SrcInitInputData%NStepWave + DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 + DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega + DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod + DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir +IF (ALLOCATED(SrcInitInputData%WaveDirArr)) THEN + i1_l = LBOUND(SrcInitInputData%WaveDirArr,1) + i1_u = UBOUND(SrcInitInputData%WaveDirArr,1) + IF (.NOT. ALLOCATED(DstInitInputData%WaveDirArr)) THEN + ALLOCATE(DstInitInputData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveDirArr = SrcInitInputData%WaveDirArr +ENDIF +IF (ALLOCATED(SrcInitInputData%WaveElevC0)) THEN + i1_l = LBOUND(SrcInitInputData%WaveElevC0,1) + i1_u = UBOUND(SrcInitInputData%WaveElevC0,1) + i2_l = LBOUND(SrcInitInputData%WaveElevC0,2) + i2_u = UBOUND(SrcInitInputData%WaveElevC0,2) + IF (.NOT. ALLOCATED(DstInitInputData%WaveElevC0)) THEN + ALLOCATE(DstInitInputData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveElevC0 = SrcInitInputData%WaveElevC0 +ENDIF +IF (ALLOCATED(SrcInitInputData%WaveTime)) THEN + i1_l = LBOUND(SrcInitInputData%WaveTime,1) + i1_u = UBOUND(SrcInitInputData%WaveTime,1) + IF (.NOT. ALLOCATED(DstInitInputData%WaveTime)) THEN + ALLOCATE(DstInitInputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveTime.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveTime = SrcInitInputData%WaveTime +ENDIF + DstInitInputData%NWaveElev = SrcInitInputData%NWaveElev +IF (ALLOCATED(SrcInitInputData%WaveElevxi)) THEN + i1_l = LBOUND(SrcInitInputData%WaveElevxi,1) + i1_u = UBOUND(SrcInitInputData%WaveElevxi,1) + IF (.NOT. ALLOCATED(DstInitInputData%WaveElevxi)) THEN + ALLOCATE(DstInitInputData%WaveElevxi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveElevxi = SrcInitInputData%WaveElevxi +ENDIF +IF (ALLOCATED(SrcInitInputData%WaveElevyi)) THEN + i1_l = LBOUND(SrcInitInputData%WaveElevyi,1) + i1_u = UBOUND(SrcInitInputData%WaveElevyi,1) + IF (.NOT. ALLOCATED(DstInitInputData%WaveElevyi)) THEN + ALLOCATE(DstInitInputData%WaveElevyi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveElevyi = SrcInitInputData%WaveElevyi +ENDIF +IF (ALLOCATED(SrcInitInputData%WaveElevXY)) THEN + i1_l = LBOUND(SrcInitInputData%WaveElevXY,1) + i1_u = UBOUND(SrcInitInputData%WaveElevXY,1) + i2_l = LBOUND(SrcInitInputData%WaveElevXY,2) + i2_u = UBOUND(SrcInitInputData%WaveElevXY,2) + IF (.NOT. ALLOCATED(DstInitInputData%WaveElevXY)) THEN + ALLOCATE(DstInitInputData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveElevXY = SrcInitInputData%WaveElevXY +ENDIF + DstInitInputData%NWaveKin = SrcInitInputData%NWaveKin +IF (ALLOCATED(SrcInitInputData%WaveKinxi)) THEN + i1_l = LBOUND(SrcInitInputData%WaveKinxi,1) + i1_u = UBOUND(SrcInitInputData%WaveKinxi,1) + IF (.NOT. ALLOCATED(DstInitInputData%WaveKinxi)) THEN + ALLOCATE(DstInitInputData%WaveKinxi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveKinxi = SrcInitInputData%WaveKinxi +ENDIF +IF (ALLOCATED(SrcInitInputData%WaveKinyi)) THEN + i1_l = LBOUND(SrcInitInputData%WaveKinyi,1) + i1_u = UBOUND(SrcInitInputData%WaveKinyi,1) + IF (.NOT. ALLOCATED(DstInitInputData%WaveKinyi)) THEN + ALLOCATE(DstInitInputData%WaveKinyi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveKinyi = SrcInitInputData%WaveKinyi +ENDIF +IF (ALLOCATED(SrcInitInputData%WaveKinzi)) THEN + i1_l = LBOUND(SrcInitInputData%WaveKinzi,1) + i1_u = UBOUND(SrcInitInputData%WaveKinzi,1) + IF (.NOT. ALLOCATED(DstInitInputData%WaveKinzi)) THEN + ALLOCATE(DstInitInputData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveKinzi = SrcInitInputData%WaveKinzi +ENDIF + DstInitInputData%WvDiffQTFF = SrcInitInputData%WvDiffQTFF + DstInitInputData%WvSumQTFF = SrcInitInputData%WvSumQTFF + DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD + DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD + DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS + DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS + DstInitInputData%OutList = SrcInitInputData%OutList + DstInitInputData%OutAll = SrcInitInputData%OutAll + DstInitInputData%NumOuts = SrcInitInputData%NumOuts + DstInitInputData%NumOutAll = SrcInitInputData%NumOutAll + END SUBROUTINE Waves2_CopyInitInput + + SUBROUTINE Waves2_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + TYPE(Waves2_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyInitInput' + + ErrStat = ErrID_None + ErrMsg = "" + +IF (ALLOCATED(InitInputData%WaveDirArr)) THEN + DEALLOCATE(InitInputData%WaveDirArr) +ENDIF +IF (ALLOCATED(InitInputData%WaveElevC0)) THEN + DEALLOCATE(InitInputData%WaveElevC0) +ENDIF +IF (ALLOCATED(InitInputData%WaveTime)) THEN + DEALLOCATE(InitInputData%WaveTime) +ENDIF +IF (ALLOCATED(InitInputData%WaveElevxi)) THEN + DEALLOCATE(InitInputData%WaveElevxi) +ENDIF +IF (ALLOCATED(InitInputData%WaveElevyi)) THEN + DEALLOCATE(InitInputData%WaveElevyi) +ENDIF +IF (ALLOCATED(InitInputData%WaveElevXY)) THEN + DEALLOCATE(InitInputData%WaveElevXY) +ENDIF +IF (ALLOCATED(InitInputData%WaveKinxi)) THEN + DEALLOCATE(InitInputData%WaveKinxi) +ENDIF +IF (ALLOCATED(InitInputData%WaveKinyi)) THEN + DEALLOCATE(InitInputData%WaveKinyi) +ENDIF +IF (ALLOCATED(InitInputData%WaveKinzi)) THEN + DEALLOCATE(InitInputData%WaveKinzi) +ENDIF + END SUBROUTINE Waves2_DestroyInitInput + + SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves2_InitInputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackInitInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! UnSum + Re_BufSz = Re_BufSz + 1 ! Gravity + Re_BufSz = Re_BufSz + 1 ! WtrDens + Re_BufSz = Re_BufSz + 1 ! WtrDpth + Int_BufSz = Int_BufSz + 1 ! NStepWave + Int_BufSz = Int_BufSz + 1 ! NStepWave2 + Re_BufSz = Re_BufSz + 1 ! WaveDOmega + Int_BufSz = Int_BufSz + 1 ! WaveStMod + Int_BufSz = Int_BufSz + 1 ! WaveMultiDir + Int_BufSz = Int_BufSz + 1 ! WaveDirArr allocated yes/no + IF ( ALLOCATED(InData%WaveDirArr) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveDirArr upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveDirArr) ! WaveDirArr + END IF + Int_BufSz = Int_BufSz + 1 ! WaveElevC0 allocated yes/no + IF ( ALLOCATED(InData%WaveElevC0) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WaveElevC0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC0) ! WaveElevC0 + END IF + Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no + IF ( ALLOCATED(InData%WaveTime) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime + END IF + Int_BufSz = Int_BufSz + 1 ! NWaveElev + Int_BufSz = Int_BufSz + 1 ! WaveElevxi allocated yes/no + IF ( ALLOCATED(InData%WaveElevxi) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveElevxi upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElevxi) ! WaveElevxi + END IF + Int_BufSz = Int_BufSz + 1 ! WaveElevyi allocated yes/no + IF ( ALLOCATED(InData%WaveElevyi) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveElevyi upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElevyi) ! WaveElevyi + END IF + Int_BufSz = Int_BufSz + 1 ! WaveElevXY allocated yes/no + IF ( ALLOCATED(InData%WaveElevXY) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WaveElevXY upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElevXY) ! WaveElevXY + END IF + Int_BufSz = Int_BufSz + 1 ! NWaveKin + Int_BufSz = Int_BufSz + 1 ! WaveKinxi allocated yes/no + IF ( ALLOCATED(InData%WaveKinxi) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveKinxi upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveKinxi) ! WaveKinxi + END IF + Int_BufSz = Int_BufSz + 1 ! WaveKinyi allocated yes/no + IF ( ALLOCATED(InData%WaveKinyi) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveKinyi upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveKinyi) ! WaveKinyi + END IF + Int_BufSz = Int_BufSz + 1 ! WaveKinzi allocated yes/no + IF ( ALLOCATED(InData%WaveKinzi) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveKinzi upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveKinzi) ! WaveKinzi + END IF + Int_BufSz = Int_BufSz + 1 ! WvDiffQTFF + Int_BufSz = Int_BufSz + 1 ! WvSumQTFF + Re_BufSz = Re_BufSz + 1 ! WvLowCOffD + Re_BufSz = Re_BufSz + 1 ! WvHiCOffD + Re_BufSz = Re_BufSz + 1 ! WvLowCOffS + Re_BufSz = Re_BufSz + 1 ! WvHiCOffS + Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList + Int_BufSz = Int_BufSz + 1 ! OutAll + Int_BufSz = Int_BufSz + 1 ! NumOuts + Int_BufSz = Int_BufSz + 1 ! NumOutAll + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave2 + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDOmega + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveStMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDirArr,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) + ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveElevC0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) + DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) + ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NWaveElev + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%WaveElevxi) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevxi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevxi,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveElevxi,1), UBOUND(InData%WaveElevxi,1) + ReKiBuf(Re_Xferred) = InData%WaveElevxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveElevyi) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevyi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevyi,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveElevyi,1), UBOUND(InData%WaveElevyi,1) + ReKiBuf(Re_Xferred) = InData%WaveElevyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) + DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) + ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NWaveKin + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%WaveKinxi) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinxi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinxi,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveKinxi,1), UBOUND(InData%WaveKinxi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveKinyi) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinyi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinyi,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveKinyi,1), UBOUND(InData%WaveKinyi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinzi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%WvDiffQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WvSumQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOffD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOffD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOffS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOffS + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO I = 1, LEN(InData%OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Waves2_PackInitInput + + SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves2_InitInputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackInitInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveStMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveDirArr)) DEALLOCATE(OutData%WaveDirArr) + ALLOCATE(OutData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) + OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElevC0)) DEALLOCATE(OutData%WaveElevC0) + ALLOCATE(OutData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) + DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) + OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) + ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%NWaveElev = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevxi not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElevxi)) DEALLOCATE(OutData%WaveElevxi) + ALLOCATE(OutData%WaveElevxi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveElevxi,1), UBOUND(OutData%WaveElevxi,1) + OutData%WaveElevxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevyi not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElevyi)) DEALLOCATE(OutData%WaveElevyi) + ALLOCATE(OutData%WaveElevyi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveElevyi,1), UBOUND(OutData%WaveElevyi,1) + OutData%WaveElevyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElevXY)) DEALLOCATE(OutData%WaveElevXY) + ALLOCATE(OutData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) + DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) + OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%NWaveKin = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinxi not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveKinxi)) DEALLOCATE(OutData%WaveKinxi) + ALLOCATE(OutData%WaveKinxi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveKinxi,1), UBOUND(OutData%WaveKinxi,1) + OutData%WaveKinxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinyi not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveKinyi)) DEALLOCATE(OutData%WaveKinyi) + ALLOCATE(OutData%WaveKinyi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveKinyi,1), UBOUND(OutData%WaveKinyi,1) + OutData%WaveKinyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveKinzi)) DEALLOCATE(OutData%WaveKinzi) + ALLOCATE(OutData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) + OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%WvDiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvDiffQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%WvSumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvSumQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%WvLowCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvLowCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%OutList,1) + i1_u = UBOUND(OutData%OutList,1) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Waves2_UnPackInitInput + + SUBROUTINE Waves2_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves2_InitOutputType), INTENT(IN) :: SrcInitOutputData + TYPE(Waves2_InitOutputType), INTENT(INOUT) :: DstInitOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyInitOutput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN + i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) + i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN + ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr +ENDIF +IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN + i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) + i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN + ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveElevSeries2)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveElevSeries2,1) + i1_u = UBOUND(SrcInitOutputData%WaveElevSeries2,1) + i2_l = LBOUND(SrcInitOutputData%WaveElevSeries2,2) + i2_u = UBOUND(SrcInitOutputData%WaveElevSeries2,2) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveElevSeries2)) THEN + ALLOCATE(DstInitOutputData%WaveElevSeries2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevSeries2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveElevSeries2 = SrcInitOutputData%WaveElevSeries2 +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveAcc2D)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveAcc2D,1) + i1_u = UBOUND(SrcInitOutputData%WaveAcc2D,1) + i2_l = LBOUND(SrcInitOutputData%WaveAcc2D,2) + i2_u = UBOUND(SrcInitOutputData%WaveAcc2D,2) + i3_l = LBOUND(SrcInitOutputData%WaveAcc2D,3) + i3_u = UBOUND(SrcInitOutputData%WaveAcc2D,3) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc2D)) THEN + ALLOCATE(DstInitOutputData%WaveAcc2D(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2D.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveAcc2D = SrcInitOutputData%WaveAcc2D +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveDynP2D)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveDynP2D,1) + i1_u = UBOUND(SrcInitOutputData%WaveDynP2D,1) + i2_l = LBOUND(SrcInitOutputData%WaveDynP2D,2) + i2_u = UBOUND(SrcInitOutputData%WaveDynP2D,2) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP2D)) THEN + ALLOCATE(DstInitOutputData%WaveDynP2D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2D.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveDynP2D = SrcInitOutputData%WaveDynP2D +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveAcc2S)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveAcc2S,1) + i1_u = UBOUND(SrcInitOutputData%WaveAcc2S,1) + i2_l = LBOUND(SrcInitOutputData%WaveAcc2S,2) + i2_u = UBOUND(SrcInitOutputData%WaveAcc2S,2) + i3_l = LBOUND(SrcInitOutputData%WaveAcc2S,3) + i3_u = UBOUND(SrcInitOutputData%WaveAcc2S,3) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc2S)) THEN + ALLOCATE(DstInitOutputData%WaveAcc2S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2S.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveAcc2S = SrcInitOutputData%WaveAcc2S +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveDynP2S)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveDynP2S,1) + i1_u = UBOUND(SrcInitOutputData%WaveDynP2S,1) + i2_l = LBOUND(SrcInitOutputData%WaveDynP2S,2) + i2_u = UBOUND(SrcInitOutputData%WaveDynP2S,2) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP2S)) THEN + ALLOCATE(DstInitOutputData%WaveDynP2S(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2S.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveDynP2S = SrcInitOutputData%WaveDynP2S +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveVel2D)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveVel2D,1) + i1_u = UBOUND(SrcInitOutputData%WaveVel2D,1) + i2_l = LBOUND(SrcInitOutputData%WaveVel2D,2) + i2_u = UBOUND(SrcInitOutputData%WaveVel2D,2) + i3_l = LBOUND(SrcInitOutputData%WaveVel2D,3) + i3_u = UBOUND(SrcInitOutputData%WaveVel2D,3) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel2D)) THEN + ALLOCATE(DstInitOutputData%WaveVel2D(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2D.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveVel2D = SrcInitOutputData%WaveVel2D +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveVel2S)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveVel2S,1) + i1_u = UBOUND(SrcInitOutputData%WaveVel2S,1) + i2_l = LBOUND(SrcInitOutputData%WaveVel2S,2) + i2_u = UBOUND(SrcInitOutputData%WaveVel2S,2) + i3_l = LBOUND(SrcInitOutputData%WaveVel2S,3) + i3_u = UBOUND(SrcInitOutputData%WaveVel2S,3) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel2S)) THEN + ALLOCATE(DstInitOutputData%WaveVel2S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2S.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveVel2S = SrcInitOutputData%WaveVel2S +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveAcc2D0)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveAcc2D0,1) + i1_u = UBOUND(SrcInitOutputData%WaveAcc2D0,1) + i2_l = LBOUND(SrcInitOutputData%WaveAcc2D0,2) + i2_u = UBOUND(SrcInitOutputData%WaveAcc2D0,2) + i3_l = LBOUND(SrcInitOutputData%WaveAcc2D0,3) + i3_u = UBOUND(SrcInitOutputData%WaveAcc2D0,3) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc2D0)) THEN + ALLOCATE(DstInitOutputData%WaveAcc2D0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2D0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveAcc2D0 = SrcInitOutputData%WaveAcc2D0 +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveDynP2D0)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveDynP2D0,1) + i1_u = UBOUND(SrcInitOutputData%WaveDynP2D0,1) + i2_l = LBOUND(SrcInitOutputData%WaveDynP2D0,2) + i2_u = UBOUND(SrcInitOutputData%WaveDynP2D0,2) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP2D0)) THEN + ALLOCATE(DstInitOutputData%WaveDynP2D0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2D0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveDynP2D0 = SrcInitOutputData%WaveDynP2D0 +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveAcc2S0)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveAcc2S0,1) + i1_u = UBOUND(SrcInitOutputData%WaveAcc2S0,1) + i2_l = LBOUND(SrcInitOutputData%WaveAcc2S0,2) + i2_u = UBOUND(SrcInitOutputData%WaveAcc2S0,2) + i3_l = LBOUND(SrcInitOutputData%WaveAcc2S0,3) + i3_u = UBOUND(SrcInitOutputData%WaveAcc2S0,3) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc2S0)) THEN + ALLOCATE(DstInitOutputData%WaveAcc2S0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2S0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveAcc2S0 = SrcInitOutputData%WaveAcc2S0 +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveDynP2S0)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveDynP2S0,1) + i1_u = UBOUND(SrcInitOutputData%WaveDynP2S0,1) + i2_l = LBOUND(SrcInitOutputData%WaveDynP2S0,2) + i2_u = UBOUND(SrcInitOutputData%WaveDynP2S0,2) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP2S0)) THEN + ALLOCATE(DstInitOutputData%WaveDynP2S0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2S0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveDynP2S0 = SrcInitOutputData%WaveDynP2S0 +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveVel2D0)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveVel2D0,1) + i1_u = UBOUND(SrcInitOutputData%WaveVel2D0,1) + i2_l = LBOUND(SrcInitOutputData%WaveVel2D0,2) + i2_u = UBOUND(SrcInitOutputData%WaveVel2D0,2) + i3_l = LBOUND(SrcInitOutputData%WaveVel2D0,3) + i3_u = UBOUND(SrcInitOutputData%WaveVel2D0,3) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel2D0)) THEN + ALLOCATE(DstInitOutputData%WaveVel2D0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2D0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveVel2D0 = SrcInitOutputData%WaveVel2D0 +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveVel2S0)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveVel2S0,1) + i1_u = UBOUND(SrcInitOutputData%WaveVel2S0,1) + i2_l = LBOUND(SrcInitOutputData%WaveVel2S0,2) + i2_u = UBOUND(SrcInitOutputData%WaveVel2S0,2) + i3_l = LBOUND(SrcInitOutputData%WaveVel2S0,3) + i3_u = UBOUND(SrcInitOutputData%WaveVel2S0,3) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel2S0)) THEN + ALLOCATE(DstInitOutputData%WaveVel2S0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2S0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveVel2S0 = SrcInitOutputData%WaveVel2S0 +ENDIF + END SUBROUTINE Waves2_CopyInitOutput + + SUBROUTINE Waves2_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + TYPE(Waves2_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyInitOutput' + + ErrStat = ErrID_None + ErrMsg = "" + +IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN + DEALLOCATE(InitOutputData%WriteOutputHdr) +ENDIF +IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN + DEALLOCATE(InitOutputData%WriteOutputUnt) +ENDIF +IF (ALLOCATED(InitOutputData%WaveElevSeries2)) THEN + DEALLOCATE(InitOutputData%WaveElevSeries2) +ENDIF +IF (ALLOCATED(InitOutputData%WaveAcc2D)) THEN + DEALLOCATE(InitOutputData%WaveAcc2D) +ENDIF +IF (ALLOCATED(InitOutputData%WaveDynP2D)) THEN + DEALLOCATE(InitOutputData%WaveDynP2D) +ENDIF +IF (ALLOCATED(InitOutputData%WaveAcc2S)) THEN + DEALLOCATE(InitOutputData%WaveAcc2S) +ENDIF +IF (ALLOCATED(InitOutputData%WaveDynP2S)) THEN + DEALLOCATE(InitOutputData%WaveDynP2S) +ENDIF +IF (ALLOCATED(InitOutputData%WaveVel2D)) THEN + DEALLOCATE(InitOutputData%WaveVel2D) +ENDIF +IF (ALLOCATED(InitOutputData%WaveVel2S)) THEN + DEALLOCATE(InitOutputData%WaveVel2S) +ENDIF +IF (ALLOCATED(InitOutputData%WaveAcc2D0)) THEN + DEALLOCATE(InitOutputData%WaveAcc2D0) +ENDIF +IF (ALLOCATED(InitOutputData%WaveDynP2D0)) THEN + DEALLOCATE(InitOutputData%WaveDynP2D0) +ENDIF +IF (ALLOCATED(InitOutputData%WaveAcc2S0)) THEN + DEALLOCATE(InitOutputData%WaveAcc2S0) +ENDIF +IF (ALLOCATED(InitOutputData%WaveDynP2S0)) THEN + DEALLOCATE(InitOutputData%WaveDynP2S0) +ENDIF +IF (ALLOCATED(InitOutputData%WaveVel2D0)) THEN + DEALLOCATE(InitOutputData%WaveVel2D0) +ENDIF +IF (ALLOCATED(InitOutputData%WaveVel2S0)) THEN + DEALLOCATE(InitOutputData%WaveVel2S0) +ENDIF + END SUBROUTINE Waves2_DestroyInitOutput + + SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves2_InitOutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackInitOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no + IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no + IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt + END IF + Int_BufSz = Int_BufSz + 1 ! WaveElevSeries2 allocated yes/no + IF ( ALLOCATED(InData%WaveElevSeries2) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WaveElevSeries2 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElevSeries2) ! WaveElevSeries2 + END IF + Int_BufSz = Int_BufSz + 1 ! WaveAcc2D allocated yes/no + IF ( ALLOCATED(InData%WaveAcc2D) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! WaveAcc2D upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc2D) ! WaveAcc2D + END IF + Int_BufSz = Int_BufSz + 1 ! WaveDynP2D allocated yes/no + IF ( ALLOCATED(InData%WaveDynP2D) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WaveDynP2D upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP2D) ! WaveDynP2D + END IF + Int_BufSz = Int_BufSz + 1 ! WaveAcc2S allocated yes/no + IF ( ALLOCATED(InData%WaveAcc2S) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! WaveAcc2S upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc2S) ! WaveAcc2S + END IF + Int_BufSz = Int_BufSz + 1 ! WaveDynP2S allocated yes/no + IF ( ALLOCATED(InData%WaveDynP2S) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WaveDynP2S upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP2S) ! WaveDynP2S + END IF + Int_BufSz = Int_BufSz + 1 ! WaveVel2D allocated yes/no + IF ( ALLOCATED(InData%WaveVel2D) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! WaveVel2D upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveVel2D) ! WaveVel2D + END IF + Int_BufSz = Int_BufSz + 1 ! WaveVel2S allocated yes/no + IF ( ALLOCATED(InData%WaveVel2S) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! WaveVel2S upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveVel2S) ! WaveVel2S + END IF + Int_BufSz = Int_BufSz + 1 ! WaveAcc2D0 allocated yes/no + IF ( ALLOCATED(InData%WaveAcc2D0) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! WaveAcc2D0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc2D0) ! WaveAcc2D0 + END IF + Int_BufSz = Int_BufSz + 1 ! WaveDynP2D0 allocated yes/no + IF ( ALLOCATED(InData%WaveDynP2D0) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WaveDynP2D0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP2D0) ! WaveDynP2D0 + END IF + Int_BufSz = Int_BufSz + 1 ! WaveAcc2S0 allocated yes/no + IF ( ALLOCATED(InData%WaveAcc2S0) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! WaveAcc2S0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc2S0) ! WaveAcc2S0 + END IF + Int_BufSz = Int_BufSz + 1 ! WaveDynP2S0 allocated yes/no + IF ( ALLOCATED(InData%WaveDynP2S0) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WaveDynP2S0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP2S0) ! WaveDynP2S0 + END IF + Int_BufSz = Int_BufSz + 1 ! WaveVel2D0 allocated yes/no + IF ( ALLOCATED(InData%WaveVel2D0) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! WaveVel2D0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveVel2D0) ! WaveVel2D0 + END IF + Int_BufSz = Int_BufSz + 1 ! WaveVel2S0 allocated yes/no + IF ( ALLOCATED(InData%WaveVel2S0) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! WaveVel2S0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveVel2S0) ! WaveVel2S0 + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO I = 1, LEN(InData%WriteOutputHdr) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO I = 1, LEN(InData%WriteOutputUnt) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveElevSeries2) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries2,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries2,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries2,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries2,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WaveElevSeries2,2), UBOUND(InData%WaveElevSeries2,2) + DO i1 = LBOUND(InData%WaveElevSeries2,1), UBOUND(InData%WaveElevSeries2,1) + ReKiBuf(Re_Xferred) = InData%WaveElevSeries2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveAcc2D) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%WaveAcc2D,3), UBOUND(InData%WaveAcc2D,3) + DO i2 = LBOUND(InData%WaveAcc2D,2), UBOUND(InData%WaveAcc2D,2) + DO i1 = LBOUND(InData%WaveAcc2D,1), UBOUND(InData%WaveAcc2D,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc2D(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveDynP2D) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2D,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2D,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WaveDynP2D,2), UBOUND(InData%WaveDynP2D,2) + DO i1 = LBOUND(InData%WaveDynP2D,1), UBOUND(InData%WaveDynP2D,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP2D(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveAcc2S) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%WaveAcc2S,3), UBOUND(InData%WaveAcc2S,3) + DO i2 = LBOUND(InData%WaveAcc2S,2), UBOUND(InData%WaveAcc2S,2) + DO i1 = LBOUND(InData%WaveAcc2S,1), UBOUND(InData%WaveAcc2S,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc2S(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveDynP2S) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2S,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2S,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WaveDynP2S,2), UBOUND(InData%WaveDynP2S,2) + DO i1 = LBOUND(InData%WaveDynP2S,1), UBOUND(InData%WaveDynP2S,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP2S(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveVel2D) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%WaveVel2D,3), UBOUND(InData%WaveVel2D,3) + DO i2 = LBOUND(InData%WaveVel2D,2), UBOUND(InData%WaveVel2D,2) + DO i1 = LBOUND(InData%WaveVel2D,1), UBOUND(InData%WaveVel2D,1) + ReKiBuf(Re_Xferred) = InData%WaveVel2D(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveVel2S) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%WaveVel2S,3), UBOUND(InData%WaveVel2S,3) + DO i2 = LBOUND(InData%WaveVel2S,2), UBOUND(InData%WaveVel2S,2) + DO i1 = LBOUND(InData%WaveVel2S,1), UBOUND(InData%WaveVel2S,1) + ReKiBuf(Re_Xferred) = InData%WaveVel2S(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveAcc2D0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D0,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D0,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D0,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%WaveAcc2D0,3), UBOUND(InData%WaveAcc2D0,3) + DO i2 = LBOUND(InData%WaveAcc2D0,2), UBOUND(InData%WaveAcc2D0,2) + DO i1 = LBOUND(InData%WaveAcc2D0,1), UBOUND(InData%WaveAcc2D0,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc2D0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveDynP2D0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2D0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2D0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D0,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WaveDynP2D0,2), UBOUND(InData%WaveDynP2D0,2) + DO i1 = LBOUND(InData%WaveDynP2D0,1), UBOUND(InData%WaveDynP2D0,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP2D0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveAcc2S0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S0,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S0,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S0,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%WaveAcc2S0,3), UBOUND(InData%WaveAcc2S0,3) + DO i2 = LBOUND(InData%WaveAcc2S0,2), UBOUND(InData%WaveAcc2S0,2) + DO i1 = LBOUND(InData%WaveAcc2S0,1), UBOUND(InData%WaveAcc2S0,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc2S0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveDynP2S0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2S0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2S0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S0,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WaveDynP2S0,2), UBOUND(InData%WaveDynP2S0,2) + DO i1 = LBOUND(InData%WaveDynP2S0,1), UBOUND(InData%WaveDynP2S0,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP2S0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveVel2D0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D0,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D0,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D0,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%WaveVel2D0,3), UBOUND(InData%WaveVel2D0,3) + DO i2 = LBOUND(InData%WaveVel2D0,2), UBOUND(InData%WaveVel2D0,2) + DO i1 = LBOUND(InData%WaveVel2D0,1), UBOUND(InData%WaveVel2D0,1) + ReKiBuf(Re_Xferred) = InData%WaveVel2D0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveVel2S0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S0,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S0,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S0,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%WaveVel2S0,3), UBOUND(InData%WaveVel2S0,3) + DO i2 = LBOUND(InData%WaveVel2S0,2), UBOUND(InData%WaveVel2S0,2) + DO i1 = LBOUND(InData%WaveVel2S0,1), UBOUND(InData%WaveVel2S0,1) + ReKiBuf(Re_Xferred) = InData%WaveVel2S0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + END SUBROUTINE Waves2_PackInitOutput + + SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves2_InitOutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackInitOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) + ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO I = 1, LEN(OutData%WriteOutputHdr) + OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) + ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO I = 1, LEN(OutData%WriteOutputUnt) + OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevSeries2 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElevSeries2)) DEALLOCATE(OutData%WaveElevSeries2) + ALLOCATE(OutData%WaveElevSeries2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WaveElevSeries2,2), UBOUND(OutData%WaveElevSeries2,2) + DO i1 = LBOUND(OutData%WaveElevSeries2,1), UBOUND(OutData%WaveElevSeries2,1) + OutData%WaveElevSeries2(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2D not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveAcc2D)) DEALLOCATE(OutData%WaveAcc2D) + ALLOCATE(OutData%WaveAcc2D(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2D.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%WaveAcc2D,3), UBOUND(OutData%WaveAcc2D,3) + DO i2 = LBOUND(OutData%WaveAcc2D,2), UBOUND(OutData%WaveAcc2D,2) + DO i1 = LBOUND(OutData%WaveAcc2D,1), UBOUND(OutData%WaveAcc2D,1) + OutData%WaveAcc2D(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2D not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveDynP2D)) DEALLOCATE(OutData%WaveDynP2D) + ALLOCATE(OutData%WaveDynP2D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2D.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WaveDynP2D,2), UBOUND(OutData%WaveDynP2D,2) + DO i1 = LBOUND(OutData%WaveDynP2D,1), UBOUND(OutData%WaveDynP2D,1) + OutData%WaveDynP2D(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2S not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveAcc2S)) DEALLOCATE(OutData%WaveAcc2S) + ALLOCATE(OutData%WaveAcc2S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2S.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%WaveAcc2S,3), UBOUND(OutData%WaveAcc2S,3) + DO i2 = LBOUND(OutData%WaveAcc2S,2), UBOUND(OutData%WaveAcc2S,2) + DO i1 = LBOUND(OutData%WaveAcc2S,1), UBOUND(OutData%WaveAcc2S,1) + OutData%WaveAcc2S(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2S not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveDynP2S)) DEALLOCATE(OutData%WaveDynP2S) + ALLOCATE(OutData%WaveDynP2S(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2S.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WaveDynP2S,2), UBOUND(OutData%WaveDynP2S,2) + DO i1 = LBOUND(OutData%WaveDynP2S,1), UBOUND(OutData%WaveDynP2S,1) + OutData%WaveDynP2S(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2D not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveVel2D)) DEALLOCATE(OutData%WaveVel2D) + ALLOCATE(OutData%WaveVel2D(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2D.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%WaveVel2D,3), UBOUND(OutData%WaveVel2D,3) + DO i2 = LBOUND(OutData%WaveVel2D,2), UBOUND(OutData%WaveVel2D,2) + DO i1 = LBOUND(OutData%WaveVel2D,1), UBOUND(OutData%WaveVel2D,1) + OutData%WaveVel2D(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2S not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveVel2S)) DEALLOCATE(OutData%WaveVel2S) + ALLOCATE(OutData%WaveVel2S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2S.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%WaveVel2S,3), UBOUND(OutData%WaveVel2S,3) + DO i2 = LBOUND(OutData%WaveVel2S,2), UBOUND(OutData%WaveVel2S,2) + DO i1 = LBOUND(OutData%WaveVel2S,1), UBOUND(OutData%WaveVel2S,1) + OutData%WaveVel2S(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2D0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveAcc2D0)) DEALLOCATE(OutData%WaveAcc2D0) + ALLOCATE(OutData%WaveAcc2D0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2D0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%WaveAcc2D0,3), UBOUND(OutData%WaveAcc2D0,3) + DO i2 = LBOUND(OutData%WaveAcc2D0,2), UBOUND(OutData%WaveAcc2D0,2) + DO i1 = LBOUND(OutData%WaveAcc2D0,1), UBOUND(OutData%WaveAcc2D0,1) + OutData%WaveAcc2D0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2D0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveDynP2D0)) DEALLOCATE(OutData%WaveDynP2D0) + ALLOCATE(OutData%WaveDynP2D0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2D0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WaveDynP2D0,2), UBOUND(OutData%WaveDynP2D0,2) + DO i1 = LBOUND(OutData%WaveDynP2D0,1), UBOUND(OutData%WaveDynP2D0,1) + OutData%WaveDynP2D0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2S0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveAcc2S0)) DEALLOCATE(OutData%WaveAcc2S0) + ALLOCATE(OutData%WaveAcc2S0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2S0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%WaveAcc2S0,3), UBOUND(OutData%WaveAcc2S0,3) + DO i2 = LBOUND(OutData%WaveAcc2S0,2), UBOUND(OutData%WaveAcc2S0,2) + DO i1 = LBOUND(OutData%WaveAcc2S0,1), UBOUND(OutData%WaveAcc2S0,1) + OutData%WaveAcc2S0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2S0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveDynP2S0)) DEALLOCATE(OutData%WaveDynP2S0) + ALLOCATE(OutData%WaveDynP2S0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2S0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WaveDynP2S0,2), UBOUND(OutData%WaveDynP2S0,2) + DO i1 = LBOUND(OutData%WaveDynP2S0,1), UBOUND(OutData%WaveDynP2S0,1) + OutData%WaveDynP2S0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2D0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveVel2D0)) DEALLOCATE(OutData%WaveVel2D0) + ALLOCATE(OutData%WaveVel2D0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2D0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%WaveVel2D0,3), UBOUND(OutData%WaveVel2D0,3) + DO i2 = LBOUND(OutData%WaveVel2D0,2), UBOUND(OutData%WaveVel2D0,2) + DO i1 = LBOUND(OutData%WaveVel2D0,1), UBOUND(OutData%WaveVel2D0,1) + OutData%WaveVel2D0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2S0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveVel2S0)) DEALLOCATE(OutData%WaveVel2S0) + ALLOCATE(OutData%WaveVel2S0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2S0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%WaveVel2S0,3), UBOUND(OutData%WaveVel2S0,3) + DO i2 = LBOUND(OutData%WaveVel2S0,2), UBOUND(OutData%WaveVel2S0,2) + DO i1 = LBOUND(OutData%WaveVel2S0,1), UBOUND(OutData%WaveVel2S0,1) + OutData%WaveVel2S0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + END SUBROUTINE Waves2_UnPackInitOutput + + SUBROUTINE Waves2_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves2_ContinuousStateType), INTENT(IN) :: SrcContStateData + TYPE(Waves2_ContinuousStateType), INTENT(INOUT) :: DstContStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyContState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstContStateData%DummyContState = SrcContStateData%DummyContState + END SUBROUTINE Waves2_CopyContState + + SUBROUTINE Waves2_DestroyContState( ContStateData, ErrStat, ErrMsg ) + TYPE(Waves2_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyContState' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Waves2_DestroyContState + + SUBROUTINE Waves2_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves2_ContinuousStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackContState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyContState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Waves2_PackContState + + SUBROUTINE Waves2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves2_ContinuousStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackContState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Waves2_UnPackContState + + SUBROUTINE Waves2_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves2_DiscreteStateType), INTENT(IN) :: SrcDiscStateData + TYPE(Waves2_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyDiscState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState + END SUBROUTINE Waves2_CopyDiscState + + SUBROUTINE Waves2_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + TYPE(Waves2_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyDiscState' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Waves2_DestroyDiscState + + SUBROUTINE Waves2_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves2_DiscreteStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackDiscState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyDiscState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Waves2_PackDiscState + + SUBROUTINE Waves2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves2_DiscreteStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackDiscState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Waves2_UnPackDiscState + + SUBROUTINE Waves2_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves2_ConstraintStateType), INTENT(IN) :: SrcConstrStateData + TYPE(Waves2_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyConstrState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState + END SUBROUTINE Waves2_CopyConstrState + + SUBROUTINE Waves2_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + TYPE(Waves2_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyConstrState' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Waves2_DestroyConstrState + + SUBROUTINE Waves2_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves2_ConstraintStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackConstrState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyConstrState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Waves2_PackConstrState + + SUBROUTINE Waves2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves2_ConstraintStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackConstrState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Waves2_UnPackConstrState + + SUBROUTINE Waves2_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves2_OtherStateType), INTENT(IN) :: SrcOtherStateData + TYPE(Waves2_OtherStateType), INTENT(INOUT) :: DstOtherStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyOtherState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState + END SUBROUTINE Waves2_CopyOtherState + + SUBROUTINE Waves2_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + TYPE(Waves2_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyOtherState' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Waves2_DestroyOtherState + + SUBROUTINE Waves2_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves2_OtherStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackOtherState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! DummyOtherState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Waves2_PackOtherState + + SUBROUTINE Waves2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves2_OtherStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackOtherState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Waves2_UnPackOtherState + + SUBROUTINE Waves2_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves2_MiscVarType), INTENT(IN) :: SrcMiscData + TYPE(Waves2_MiscVarType), INTENT(INOUT) :: DstMiscData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyMisc' +! + ErrStat = ErrID_None + ErrMsg = "" + DstMiscData%LastIndWave = SrcMiscData%LastIndWave + END SUBROUTINE Waves2_CopyMisc + + SUBROUTINE Waves2_DestroyMisc( MiscData, ErrStat, ErrMsg ) + TYPE(Waves2_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyMisc' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Waves2_DestroyMisc + + SUBROUTINE Waves2_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves2_MiscVarType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackMisc' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! LastIndWave + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Waves2_PackMisc + + SUBROUTINE Waves2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves2_MiscVarType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackMisc' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Waves2_UnPackMisc + + SUBROUTINE Waves2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves2_ParameterType), INTENT(IN) :: SrcParamData + TYPE(Waves2_ParameterType), INTENT(INOUT) :: DstParamData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyParam' +! + ErrStat = ErrID_None + ErrMsg = "" + DstParamData%DT = SrcParamData%DT + DstParamData%WvDiffQTFF = SrcParamData%WvDiffQTFF + DstParamData%WvSumQTFF = SrcParamData%WvSumQTFF + DstParamData%NWaveElev = SrcParamData%NWaveElev + DstParamData%NStepWave = SrcParamData%NStepWave + DstParamData%NStepWave2 = SrcParamData%NStepWave2 +IF (ALLOCATED(SrcParamData%WaveTime)) THEN + i1_l = LBOUND(SrcParamData%WaveTime,1) + i1_u = UBOUND(SrcParamData%WaveTime,1) + IF (.NOT. ALLOCATED(DstParamData%WaveTime)) THEN + ALLOCATE(DstParamData%WaveTime(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveTime.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%WaveTime = SrcParamData%WaveTime +ENDIF +IF (ALLOCATED(SrcParamData%WaveElev2)) THEN + i1_l = LBOUND(SrcParamData%WaveElev2,1) + i1_u = UBOUND(SrcParamData%WaveElev2,1) + i2_l = LBOUND(SrcParamData%WaveElev2,2) + i2_u = UBOUND(SrcParamData%WaveElev2,2) + IF (.NOT. ALLOCATED(DstParamData%WaveElev2)) THEN + ALLOCATE(DstParamData%WaveElev2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElev2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%WaveElev2 = SrcParamData%WaveElev2 +ENDIF +IF (ALLOCATED(SrcParamData%OutParam)) THEN + i1_l = LBOUND(SrcParamData%OutParam,1) + i1_u = UBOUND(SrcParamData%OutParam,1) + IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN + ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumOutAll = SrcParamData%NumOutAll + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutSFmt = SrcParamData%OutSFmt + DstParamData%Delim = SrcParamData%Delim + DstParamData%UnOutFile = SrcParamData%UnOutFile + END SUBROUTINE Waves2_CopyParam + + SUBROUTINE Waves2_DestroyParam( ParamData, ErrStat, ErrMsg ) + TYPE(Waves2_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyParam' + + ErrStat = ErrID_None + ErrMsg = "" + +IF (ALLOCATED(ParamData%WaveTime)) THEN + DEALLOCATE(ParamData%WaveTime) +ENDIF +IF (ALLOCATED(ParamData%WaveElev2)) THEN + DEALLOCATE(ParamData%WaveElev2) +ENDIF +IF (ALLOCATED(ParamData%OutParam)) THEN +DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) + CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ParamData%OutParam) +ENDIF + END SUBROUTINE Waves2_DestroyParam + + SUBROUTINE Waves2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves2_ParameterType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackParam' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Db_BufSz = Db_BufSz + 1 ! DT + Int_BufSz = Int_BufSz + 1 ! WvDiffQTFF + Int_BufSz = Int_BufSz + 1 ! WvSumQTFF + Int_BufSz = Int_BufSz + 1 ! NWaveElev + Int_BufSz = Int_BufSz + 1 ! NStepWave + Int_BufSz = Int_BufSz + 1 ! NStepWave2 + Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no + IF ( ALLOCATED(InData%WaveTime) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime + END IF + Int_BufSz = Int_BufSz + 1 ! WaveElev2 allocated yes/no + IF ( ALLOCATED(InData%WaveElev2) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WaveElev2 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElev2) ! WaveElev2 + END IF + Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no + IF ( ALLOCATED(InData%OutParam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) + Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutParam + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutParam + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutParam + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! NumOuts + Int_BufSz = Int_BufSz + 1 ! NumOutAll + Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt + Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt + Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim + Int_BufSz = Int_BufSz + 1 ! UnOutFile + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WvDiffQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WvSumQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveElev + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave2 + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveElev2) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WaveElev2,2), UBOUND(InData%WaveElev2,2) + DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) + ReKiBuf(Re_Xferred) = InData%WaveElev2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Waves2_PackParam + + SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves2_ParameterType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackParam' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WvDiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvDiffQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%WvSumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvSumQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%NWaveElev = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) + ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev2 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElev2)) DEALLOCATE(OutData%WaveElev2) + ALLOCATE(OutData%WaveElev2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WaveElev2,2), UBOUND(OutData%WaveElev2,2) + DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) + OutData%WaveElev2(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) + ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Waves2_UnPackParam + + SUBROUTINE Waves2_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves2_InputType), INTENT(IN) :: SrcInputData + TYPE(Waves2_InputType), INTENT(INOUT) :: DstInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyInput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInputData%DummyInput = SrcInputData%DummyInput + END SUBROUTINE Waves2_CopyInput + + SUBROUTINE Waves2_DestroyInput( InputData, ErrStat, ErrMsg ) + TYPE(Waves2_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyInput' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Waves2_DestroyInput + + SUBROUTINE Waves2_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves2_InputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyInput + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyInput + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Waves2_PackInput + + SUBROUTINE Waves2_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves2_InputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyInput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Waves2_UnPackInput + + SUBROUTINE Waves2_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves2_OutputType), INTENT(IN) :: SrcOutputData + TYPE(Waves2_OutputType), INTENT(INOUT) :: DstOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyOutput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN + i1_l = LBOUND(SrcOutputData%WriteOutput,1) + i1_u = UBOUND(SrcOutputData%WriteOutput,1) + IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN + ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%WriteOutput = SrcOutputData%WriteOutput +ENDIF + END SUBROUTINE Waves2_CopyOutput + + SUBROUTINE Waves2_DestroyOutput( OutputData, ErrStat, ErrMsg ) + TYPE(Waves2_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyOutput' + + ErrStat = ErrID_None + ErrMsg = "" + +IF (ALLOCATED(OutputData%WriteOutput)) THEN + DEALLOCATE(OutputData%WriteOutput) +ENDIF + END SUBROUTINE Waves2_DestroyOutput + + SUBROUTINE Waves2_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves2_OutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no + IF ( ALLOCATED(InData%WriteOutput) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE Waves2_PackOutput + + SUBROUTINE Waves2_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves2_OutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) + ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE Waves2_UnPackOutput + + + SUBROUTINE Waves2_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(Waves2_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs + TYPE(Waves2_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Input_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .ne. size(u)) then + CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) + RETURN + endif + order = SIZE(u) - 1 + IF ( order .eq. 0 ) THEN + CALL Waves2_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL Waves2_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 2 ) THEN + CALL Waves2_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE + CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) + RETURN + ENDIF + END SUBROUTINE Waves2_Input_ExtrapInterp + + + SUBROUTINE Waves2_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = u1, f(t2) = u2 +! +!.................................................................................................................................. + + TYPE(Waves2_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(Waves2_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(Waves2_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Input_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) + b = -(u1%DummyInput - u2%DummyInput) + u_out%DummyInput = u1%DummyInput + b * ScaleFactor + END SUBROUTINE Waves2_Input_ExtrapInterp1 + + + SUBROUTINE Waves2_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 +! +!.................................................................................................................................. + + TYPE(Waves2_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(Waves2_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(Waves2_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(Waves2_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Input_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor + c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor + u_out%DummyInput = u1%DummyInput + b + c * t_out + END SUBROUTINE Waves2_Input_ExtrapInterp2 + + + SUBROUTINE Waves2_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(Waves2_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs + TYPE(Waves2_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Output_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .ne. size(y)) then + CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) + RETURN + endif + order = SIZE(y) - 1 + IF ( order .eq. 0 ) THEN + CALL Waves2_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL Waves2_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 2 ) THEN + CALL Waves2_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE + CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) + RETURN + ENDIF + END SUBROUTINE Waves2_Output_ExtrapInterp + + + SUBROUTINE Waves2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = y1, f(t2) = y2 +! +!.................................................................................................................................. + + TYPE(Waves2_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(Waves2_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(Waves2_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Output_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) +IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO +END IF ! check if allocated + END SUBROUTINE Waves2_Output_ExtrapInterp1 + + + SUBROUTINE Waves2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 +! +!.................................................................................................................................. + + TYPE(Waves2_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(Waves2_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(Waves2_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(Waves2_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) +IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO +END IF ! check if allocated + END SUBROUTINE Waves2_Output_ExtrapInterp2 + +END MODULE Waves2_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Waves_Types.f90 b/modules/hydrodyn/src/Waves_Types.f90 new file mode 100644 index 0000000000..6207cb31d2 --- /dev/null +++ b/modules/hydrodyn/src/Waves_Types.f90 @@ -0,0 +1,3586 @@ +!STARTOFREGISTRYGENERATEDFILE 'Waves_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 +!********************************************************************************************************************************* +! Waves_Types +!................................................................................................................................. +! This file is part of Waves. +! +! 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 Waves. 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 Waves_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE +! ========= Waves_InitInputType ======= + TYPE, PUBLIC :: Waves_InitInputType + CHARACTER(1024) :: InputFile !< Name of the input file [-] + CHARACTER(1024) :: DirRoot !< The name of the root file including the full path. This may be useful if you want this routine to write a permanent record of what it does to be stored with the simulation results: the results should be stored in a file whose name (including path) is generated by appending any suitable extension to DirRoot. [-] + CHARACTER(1024) :: WvKinFile !< The root name of user input wave kinematics files [-] + LOGICAL :: WriteWvKin !< Flag indicating whether we are going to write out kinematics files. [Must be FALSE if WaveMod = 5 or 6, if TRUE then WvKinFile must have a string value and this is the rootname for all the output files] [-] + INTEGER(IntKi) :: UnSum !< The unit number for the HydroDyn summary file [-] + REAL(ReKi) :: Gravity !< Gravitational acceleration [(m/s^2)] + REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [positive upward; must be zero if using WAMIT] [(meters)] + REAL(SiKi) :: WvLowCOff !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] + REAL(SiKi) :: WvHiCOff !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] + REAL(SiKi) :: WaveDir !< Mean incident wave propagation heading direction [(degrees)] + INTEGER(IntKi) :: WaveNDir !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] + LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] + INTEGER(IntKi) :: WaveDirMod !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] + REAL(SiKi) :: WaveDirSpread !< Spreading coefficient [WaveMod=2,3,4 and WaveDirMod=1] [-] + REAL(SiKi) :: WaveDirRange !< Range of wave directions (full range: WaveDir +/- WaveDirRange/2) [only used if WaveMod=6] [(degrees)] + REAL(DbKi) :: WaveDT !< Time step for incident wave calculations [(sec)] + REAL(SiKi) :: WaveHs !< Significant wave height of incident waves [(meters)] + INTEGER(IntKi) :: WaveMod !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] + CHARACTER(80) :: WaveModChr !< String to temporarially hold the value of the wave kinematics input line [-] + LOGICAL :: WaveNDAmp !< Flag for normally-distributed amplitudes in incident waves spectrum [flag] [-] + REAL(SiKi) :: WavePhase !< Specified phase for regular waves [(radians)] + REAL(SiKi) :: WavePkShp !< Peak shape parameter of incident wave spectrum [1.0 for Pierson-Moskowitz] [-] + CHARACTER(80) :: WavePkShpChr !< String to temporarially hold value of peak shape parameter input line [-] + INTEGER(IntKi) , DIMENSION(1:2) :: WaveSeed !< Random seeds of incident waves [-2147483648 to 2147483647] [-] + INTEGER(IntKi) :: WaveStMod !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] + REAL(DbKi) :: WaveTMax !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] + REAL(SiKi) :: WaveTp !< Peak spectral period of incident waves [(sec)] + REAL(SiKi) :: WtrDens !< Water density [(kg/m^3)] + REAL(SiKi) :: WtrDpth !< Water depth [(meters)] + INTEGER(IntKi) :: NWaveElev !< Number of points where the incident wave elevations can be output [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevxi !< xi-coordinates for points where the incident wave elevations can be output [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevyi !< yi-coordinates for points where the incident wave elevations can be output [(meters)] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevXY !< Supplied by Driver: X-Y locations for WaveElevation output (for visualization). Index 1 corresponds to X or Y coordinate. Index 2 corresponds to point number. [-] + REAL(ReKi) :: PtfmLocationX !< Copy of X coordinate of platform location in the wave field, used to offset/phase-shift all wave kinematics to account for location in the farm [m] + REAL(ReKi) :: PtfmLocationY !< Copy of Y coordinate of platform location in the wave field, used to offset/phase-shift all wave kinematics to account for location in the farm [m] + INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] + INTEGER(IntKi) :: NWaveKin !< Number of points where the incident wave kinematics will be computed [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinyi !< yi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinzi !< zi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVxi !< xi-component of the current velocity at elevation i [(m/s)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVyi !< yi-component of the current velocity at elevation i [(m/s)] + REAL(SiKi) :: PCurrVxiPz0 !< xi-component of the partial derivative of the current velocity at elevation near mean sea level [(m/s)] + REAL(SiKi) :: PCurrVyiPz0 !< yi-component of the partial derivative of the current velocity at elevation near mean sea level [(m/s)] + TYPE(NWTC_RandomNumber_ParameterType) :: RNG !< Parameters for the pseudo random number generator [-] + END TYPE Waves_InitInputType +! ======================= +! ========= Waves_InitOutputType ======= + TYPE, PUBLIC :: Waves_InitOutputType + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevC0 !< Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveDirArr !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] + REAL(SiKi) :: WaveDirMin !< Minimum wave direction. [(degrees)] + REAL(SiKi) :: WaveDirMax !< Maximum wave direction. [(degrees)] + REAL(SiKi) :: WaveDir !< Incident wave propagation heading direction [(degrees)] + INTEGER(IntKi) :: WaveNDir !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] + LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] + REAL(SiKi) :: WaveDOmega !< Frequency step for incident wave calculations [(rad/s)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinzi !< zi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean see level [(meters)] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: 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)] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: 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)] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: 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)] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: 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)] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: 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)] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: PWaveVel0 !< Instantaneous velocity 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 (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev !< Instantaneous elevation time-series of incident waves at each of the NWaveElev points where the incident wave elevations can be output [(meters)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevMD !< Instantaneous elevation time-series of incident waves at hard coded grid for temporary use in MoorDyn [(m)] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevSeries !< Instantaneous elevation time-series at each of the points given by WaveElevXY. Used for making movies of the waves. First index is the timestep. Second index is XY point number corresponding to second index of WaveElevXY. [(m)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Simulation times at which the instantaneous elevation of, velocity of, acceleration of, and loads associated with the incident waves are determined [(sec)] + REAL(DbKi) :: WaveTMax !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: nodeInWater !< Logical flag indicating if the node at the given time step is in the water, and hence needs to have hydrodynamic forces calculated [-] + REAL(SiKi) :: RhoXg !< = WtrDens*Gravity [-] + INTEGER(IntKi) :: NStepWave !< Total number of frequency components = total number of time steps in the incident wave [-] + INTEGER(IntKi) :: NStepWave2 !< NStepWave / 2 [-] + END TYPE Waves_InitOutputType +! ======================= +! ========= Waves_ContinuousStateType ======= + TYPE, PUBLIC :: Waves_ContinuousStateType + REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] + END TYPE Waves_ContinuousStateType +! ======================= +! ========= Waves_DiscreteStateType ======= + TYPE, PUBLIC :: Waves_DiscreteStateType + REAL(SiKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + END TYPE Waves_DiscreteStateType +! ======================= +! ========= Waves_ConstraintStateType ======= + TYPE, PUBLIC :: Waves_ConstraintStateType + REAL(SiKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + END TYPE Waves_ConstraintStateType +! ======================= +! ========= Waves_OtherStateType ======= + TYPE, PUBLIC :: Waves_OtherStateType + INTEGER(IntKi) :: DummyOtherState !< Remove this variable if you have other states [-] + END TYPE Waves_OtherStateType +! ======================= +! ========= Waves_MiscVarType ======= + TYPE, PUBLIC :: Waves_MiscVarType + INTEGER(IntKi) :: DummyMiscVar !< Remove this variable if you have misc/optimization variables [-] + END TYPE Waves_MiscVarType +! ======================= +! ========= Waves_ParameterType ======= + TYPE, PUBLIC :: Waves_ParameterType + REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] + REAL(DbKi) :: WaveTMax !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] + INTEGER(IntKi) :: NStepWave !< Total number of frequency components = total number of time steps in the incident wave [-] + INTEGER(IntKi) :: WaveNDir !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] + LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] + END TYPE Waves_ParameterType +! ======================= +! ========= Waves_InputType ======= + TYPE, PUBLIC :: Waves_InputType + REAL(SiKi) :: DummyInput !< Remove this variable if you have input data [-] + END TYPE Waves_InputType +! ======================= +! ========= Waves_OutputType ======= + TYPE, PUBLIC :: Waves_OutputType + REAL(SiKi) :: DummyOutput !< Remove this variable if you have output data [-] + END TYPE Waves_OutputType +! ======================= +CONTAINS + SUBROUTINE Waves_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves_InitInputType), INTENT(IN) :: SrcInitInputData + TYPE(Waves_InitInputType), INTENT(INOUT) :: DstInitInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyInitInput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%DirRoot = SrcInitInputData%DirRoot + DstInitInputData%WvKinFile = SrcInitInputData%WvKinFile + DstInitInputData%WriteWvKin = SrcInitInputData%WriteWvKin + DstInitInputData%UnSum = SrcInitInputData%UnSum + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL + DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff + DstInitInputData%WvHiCOff = SrcInitInputData%WvHiCOff + DstInitInputData%WaveDir = SrcInitInputData%WaveDir + DstInitInputData%WaveNDir = SrcInitInputData%WaveNDir + DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir + DstInitInputData%WaveDirMod = SrcInitInputData%WaveDirMod + DstInitInputData%WaveDirSpread = SrcInitInputData%WaveDirSpread + DstInitInputData%WaveDirRange = SrcInitInputData%WaveDirRange + DstInitInputData%WaveDT = SrcInitInputData%WaveDT + DstInitInputData%WaveHs = SrcInitInputData%WaveHs + DstInitInputData%WaveMod = SrcInitInputData%WaveMod + DstInitInputData%WaveModChr = SrcInitInputData%WaveModChr + DstInitInputData%WaveNDAmp = SrcInitInputData%WaveNDAmp + DstInitInputData%WavePhase = SrcInitInputData%WavePhase + DstInitInputData%WavePkShp = SrcInitInputData%WavePkShp + DstInitInputData%WavePkShpChr = SrcInitInputData%WavePkShpChr + DstInitInputData%WaveSeed = SrcInitInputData%WaveSeed + DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod + DstInitInputData%WaveTMax = SrcInitInputData%WaveTMax + DstInitInputData%WaveTp = SrcInitInputData%WaveTp + DstInitInputData%WtrDens = SrcInitInputData%WtrDens + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%NWaveElev = SrcInitInputData%NWaveElev +IF (ALLOCATED(SrcInitInputData%WaveElevxi)) THEN + i1_l = LBOUND(SrcInitInputData%WaveElevxi,1) + i1_u = UBOUND(SrcInitInputData%WaveElevxi,1) + IF (.NOT. ALLOCATED(DstInitInputData%WaveElevxi)) THEN + ALLOCATE(DstInitInputData%WaveElevxi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveElevxi = SrcInitInputData%WaveElevxi +ENDIF +IF (ALLOCATED(SrcInitInputData%WaveElevyi)) THEN + i1_l = LBOUND(SrcInitInputData%WaveElevyi,1) + i1_u = UBOUND(SrcInitInputData%WaveElevyi,1) + IF (.NOT. ALLOCATED(DstInitInputData%WaveElevyi)) THEN + ALLOCATE(DstInitInputData%WaveElevyi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveElevyi = SrcInitInputData%WaveElevyi +ENDIF +IF (ALLOCATED(SrcInitInputData%WaveElevXY)) THEN + i1_l = LBOUND(SrcInitInputData%WaveElevXY,1) + i1_u = UBOUND(SrcInitInputData%WaveElevXY,1) + i2_l = LBOUND(SrcInitInputData%WaveElevXY,2) + i2_u = UBOUND(SrcInitInputData%WaveElevXY,2) + IF (.NOT. ALLOCATED(DstInitInputData%WaveElevXY)) THEN + ALLOCATE(DstInitInputData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveElevXY = SrcInitInputData%WaveElevXY +ENDIF + DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX + DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY + DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod + DstInitInputData%NWaveKin = SrcInitInputData%NWaveKin +IF (ALLOCATED(SrcInitInputData%WaveKinxi)) THEN + i1_l = LBOUND(SrcInitInputData%WaveKinxi,1) + i1_u = UBOUND(SrcInitInputData%WaveKinxi,1) + IF (.NOT. ALLOCATED(DstInitInputData%WaveKinxi)) THEN + ALLOCATE(DstInitInputData%WaveKinxi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveKinxi = SrcInitInputData%WaveKinxi +ENDIF +IF (ALLOCATED(SrcInitInputData%WaveKinyi)) THEN + i1_l = LBOUND(SrcInitInputData%WaveKinyi,1) + i1_u = UBOUND(SrcInitInputData%WaveKinyi,1) + IF (.NOT. ALLOCATED(DstInitInputData%WaveKinyi)) THEN + ALLOCATE(DstInitInputData%WaveKinyi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveKinyi = SrcInitInputData%WaveKinyi +ENDIF +IF (ALLOCATED(SrcInitInputData%WaveKinzi)) THEN + i1_l = LBOUND(SrcInitInputData%WaveKinzi,1) + i1_u = UBOUND(SrcInitInputData%WaveKinzi,1) + IF (.NOT. ALLOCATED(DstInitInputData%WaveKinzi)) THEN + ALLOCATE(DstInitInputData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveKinzi = SrcInitInputData%WaveKinzi +ENDIF +IF (ALLOCATED(SrcInitInputData%CurrVxi)) THEN + i1_l = LBOUND(SrcInitInputData%CurrVxi,1) + i1_u = UBOUND(SrcInitInputData%CurrVxi,1) + IF (.NOT. ALLOCATED(DstInitInputData%CurrVxi)) THEN + ALLOCATE(DstInitInputData%CurrVxi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CurrVxi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%CurrVxi = SrcInitInputData%CurrVxi +ENDIF +IF (ALLOCATED(SrcInitInputData%CurrVyi)) THEN + i1_l = LBOUND(SrcInitInputData%CurrVyi,1) + i1_u = UBOUND(SrcInitInputData%CurrVyi,1) + IF (.NOT. ALLOCATED(DstInitInputData%CurrVyi)) THEN + ALLOCATE(DstInitInputData%CurrVyi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CurrVyi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%CurrVyi = SrcInitInputData%CurrVyi +ENDIF + DstInitInputData%PCurrVxiPz0 = SrcInitInputData%PCurrVxiPz0 + DstInitInputData%PCurrVyiPz0 = SrcInitInputData%PCurrVyiPz0 + CALL NWTC_Library_Copynwtc_randomnumber_parametertype( SrcInitInputData%RNG, DstInitInputData%RNG, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE Waves_CopyInitInput + + SUBROUTINE Waves_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + TYPE(Waves_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyInitInput' + + ErrStat = ErrID_None + ErrMsg = "" + +IF (ALLOCATED(InitInputData%WaveElevxi)) THEN + DEALLOCATE(InitInputData%WaveElevxi) +ENDIF +IF (ALLOCATED(InitInputData%WaveElevyi)) THEN + DEALLOCATE(InitInputData%WaveElevyi) +ENDIF +IF (ALLOCATED(InitInputData%WaveElevXY)) THEN + DEALLOCATE(InitInputData%WaveElevXY) +ENDIF +IF (ALLOCATED(InitInputData%WaveKinxi)) THEN + DEALLOCATE(InitInputData%WaveKinxi) +ENDIF +IF (ALLOCATED(InitInputData%WaveKinyi)) THEN + DEALLOCATE(InitInputData%WaveKinyi) +ENDIF +IF (ALLOCATED(InitInputData%WaveKinzi)) THEN + DEALLOCATE(InitInputData%WaveKinzi) +ENDIF +IF (ALLOCATED(InitInputData%CurrVxi)) THEN + DEALLOCATE(InitInputData%CurrVxi) +ENDIF +IF (ALLOCATED(InitInputData%CurrVyi)) THEN + DEALLOCATE(InitInputData%CurrVyi) +ENDIF + CALL NWTC_Library_DestroyNWTC_RandomNumber_ParameterType( InitInputData%RNG, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE Waves_DestroyInitInput + + SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves_InitInputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackInitInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile + Int_BufSz = Int_BufSz + 1*LEN(InData%DirRoot) ! DirRoot + Int_BufSz = Int_BufSz + 1*LEN(InData%WvKinFile) ! WvKinFile + Int_BufSz = Int_BufSz + 1 ! WriteWvKin + Int_BufSz = Int_BufSz + 1 ! UnSum + Re_BufSz = Re_BufSz + 1 ! Gravity + Re_BufSz = Re_BufSz + 1 ! MSL2SWL + Re_BufSz = Re_BufSz + 1 ! WvLowCOff + Re_BufSz = Re_BufSz + 1 ! WvHiCOff + Re_BufSz = Re_BufSz + 1 ! WaveDir + Int_BufSz = Int_BufSz + 1 ! WaveNDir + Int_BufSz = Int_BufSz + 1 ! WaveMultiDir + Int_BufSz = Int_BufSz + 1 ! WaveDirMod + Re_BufSz = Re_BufSz + 1 ! WaveDirSpread + Re_BufSz = Re_BufSz + 1 ! WaveDirRange + Db_BufSz = Db_BufSz + 1 ! WaveDT + Re_BufSz = Re_BufSz + 1 ! WaveHs + Int_BufSz = Int_BufSz + 1 ! WaveMod + Int_BufSz = Int_BufSz + 1*LEN(InData%WaveModChr) ! WaveModChr + Int_BufSz = Int_BufSz + 1 ! WaveNDAmp + Re_BufSz = Re_BufSz + 1 ! WavePhase + Re_BufSz = Re_BufSz + 1 ! WavePkShp + Int_BufSz = Int_BufSz + 1*LEN(InData%WavePkShpChr) ! WavePkShpChr + Int_BufSz = Int_BufSz + SIZE(InData%WaveSeed) ! WaveSeed + Int_BufSz = Int_BufSz + 1 ! WaveStMod + Db_BufSz = Db_BufSz + 1 ! WaveTMax + Re_BufSz = Re_BufSz + 1 ! WaveTp + Re_BufSz = Re_BufSz + 1 ! WtrDens + Re_BufSz = Re_BufSz + 1 ! WtrDpth + Int_BufSz = Int_BufSz + 1 ! NWaveElev + Int_BufSz = Int_BufSz + 1 ! WaveElevxi allocated yes/no + IF ( ALLOCATED(InData%WaveElevxi) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveElevxi upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElevxi) ! WaveElevxi + END IF + Int_BufSz = Int_BufSz + 1 ! WaveElevyi allocated yes/no + IF ( ALLOCATED(InData%WaveElevyi) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveElevyi upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElevyi) ! WaveElevyi + END IF + Int_BufSz = Int_BufSz + 1 ! WaveElevXY allocated yes/no + IF ( ALLOCATED(InData%WaveElevXY) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WaveElevXY upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElevXY) ! WaveElevXY + END IF + Re_BufSz = Re_BufSz + 1 ! PtfmLocationX + Re_BufSz = Re_BufSz + 1 ! PtfmLocationY + Int_BufSz = Int_BufSz + 1 ! WaveFieldMod + Int_BufSz = Int_BufSz + 1 ! NWaveKin + Int_BufSz = Int_BufSz + 1 ! WaveKinxi allocated yes/no + IF ( ALLOCATED(InData%WaveKinxi) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveKinxi upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveKinxi) ! WaveKinxi + END IF + Int_BufSz = Int_BufSz + 1 ! WaveKinyi allocated yes/no + IF ( ALLOCATED(InData%WaveKinyi) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveKinyi upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveKinyi) ! WaveKinyi + END IF + Int_BufSz = Int_BufSz + 1 ! WaveKinzi allocated yes/no + IF ( ALLOCATED(InData%WaveKinzi) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveKinzi upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveKinzi) ! WaveKinzi + END IF + Int_BufSz = Int_BufSz + 1 ! CurrVxi allocated yes/no + IF ( ALLOCATED(InData%CurrVxi) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! CurrVxi upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CurrVxi) ! CurrVxi + END IF + Int_BufSz = Int_BufSz + 1 ! CurrVyi allocated yes/no + IF ( ALLOCATED(InData%CurrVyi) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! CurrVyi upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CurrVyi) ! CurrVyi + END IF + Re_BufSz = Re_BufSz + 1 ! PCurrVxiPz0 + Re_BufSz = Re_BufSz + 1 ! PCurrVyiPz0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! RNG: size of buffers for each call to pack subtype + CALL NWTC_Library_PackNWTC_RandomNumber_ParameterType( Re_Buf, Db_Buf, Int_Buf, InData%RNG, ErrStat2, ErrMsg2, .TRUE. ) ! RNG + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! RNG + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! RNG + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! RNG + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DirRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%WvKinFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%WvKinFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%WriteWvKin, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MSL2SWL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveNDir + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveDirMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirSpread + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirRange + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%WaveDT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveHs + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveMod + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%WaveModChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%WaveModChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveNDAmp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WavePhase + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WavePkShp + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%WavePkShpChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%WavePkShpChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i1 = LBOUND(InData%WaveSeed,1), UBOUND(InData%WaveSeed,1) + IntKiBuf(Int_Xferred) = InData%WaveSeed(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%WaveStMod + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%WaveTMax + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveTp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveElev + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%WaveElevxi) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevxi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevxi,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveElevxi,1), UBOUND(InData%WaveElevxi,1) + ReKiBuf(Re_Xferred) = InData%WaveElevxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveElevyi) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevyi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevyi,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveElevyi,1), UBOUND(InData%WaveElevyi,1) + ReKiBuf(Re_Xferred) = InData%WaveElevyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) + DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) + ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + ReKiBuf(Re_Xferred) = InData%PtfmLocationX + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmLocationY + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveFieldMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveKin + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%WaveKinxi) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinxi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinxi,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveKinxi,1), UBOUND(InData%WaveKinxi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveKinyi) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinyi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinyi,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveKinyi,1), UBOUND(InData%WaveKinyi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinzi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%CurrVxi) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CurrVxi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVxi,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%CurrVxi,1), UBOUND(InData%CurrVxi,1) + ReKiBuf(Re_Xferred) = InData%CurrVxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%CurrVyi) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CurrVyi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVyi,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%CurrVyi,1), UBOUND(InData%CurrVyi,1) + ReKiBuf(Re_Xferred) = InData%CurrVyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%PCurrVxiPz0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PCurrVyiPz0 + Re_Xferred = Re_Xferred + 1 + CALL NWTC_Library_PackNWTC_RandomNumber_ParameterType( Re_Buf, Db_Buf, Int_Buf, InData%RNG, ErrStat2, ErrMsg2, OnlySize ) ! RNG + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE Waves_PackInitInput + + SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves_InitInputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackInitInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DirRoot) + OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%WvKinFile) + OutData%WvKinFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%WriteWvKin = TRANSFER(IntKiBuf(Int_Xferred), OutData%WriteWvKin) + Int_Xferred = Int_Xferred + 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WvLowCOff = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOff = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveNDir = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDirMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDirSpread = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDirRange = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WaveHs = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%WaveModChr) + OutData%WaveModChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%WaveNDAmp = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveNDAmp) + Int_Xferred = Int_Xferred + 1 + OutData%WavePhase = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WavePkShp = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%WavePkShpChr) + OutData%WavePkShpChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + i1_l = LBOUND(OutData%WaveSeed,1) + i1_u = UBOUND(OutData%WaveSeed,1) + DO i1 = LBOUND(OutData%WaveSeed,1), UBOUND(OutData%WaveSeed,1) + OutData%WaveSeed(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%WaveStMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveTMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WaveTp = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%NWaveElev = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevxi not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElevxi)) DEALLOCATE(OutData%WaveElevxi) + ALLOCATE(OutData%WaveElevxi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveElevxi,1), UBOUND(OutData%WaveElevxi,1) + OutData%WaveElevxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevyi not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElevyi)) DEALLOCATE(OutData%WaveElevyi) + ALLOCATE(OutData%WaveElevyi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveElevyi,1), UBOUND(OutData%WaveElevyi,1) + OutData%WaveElevyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElevXY)) DEALLOCATE(OutData%WaveElevXY) + ALLOCATE(OutData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) + DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) + OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%PtfmLocationX = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmLocationY = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WaveFieldMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NWaveKin = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinxi not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveKinxi)) DEALLOCATE(OutData%WaveKinxi) + ALLOCATE(OutData%WaveKinxi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveKinxi,1), UBOUND(OutData%WaveKinxi,1) + OutData%WaveKinxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinyi not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveKinyi)) DEALLOCATE(OutData%WaveKinyi) + ALLOCATE(OutData%WaveKinyi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveKinyi,1), UBOUND(OutData%WaveKinyi,1) + OutData%WaveKinyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveKinzi)) DEALLOCATE(OutData%WaveKinzi) + ALLOCATE(OutData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) + OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVxi not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CurrVxi)) DEALLOCATE(OutData%CurrVxi) + ALLOCATE(OutData%CurrVxi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%CurrVxi,1), UBOUND(OutData%CurrVxi,1) + OutData%CurrVxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVyi not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CurrVyi)) DEALLOCATE(OutData%CurrVyi) + ALLOCATE(OutData%CurrVyi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%CurrVyi,1), UBOUND(OutData%CurrVyi,1) + OutData%CurrVyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%PCurrVxiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%PCurrVyiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_UnpackNWTC_RandomNumber_ParameterType( Re_Buf, Db_Buf, Int_Buf, OutData%RNG, ErrStat2, ErrMsg2 ) ! RNG + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE Waves_UnPackInitInput + + SUBROUTINE Waves_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves_InitOutputType), INTENT(IN) :: SrcInitOutputData + TYPE(Waves_InitOutputType), INTENT(INOUT) :: DstInitOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyInitOutput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcInitOutputData%WaveElevC0)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveElevC0,1) + i1_u = UBOUND(SrcInitOutputData%WaveElevC0,1) + i2_l = LBOUND(SrcInitOutputData%WaveElevC0,2) + i2_u = UBOUND(SrcInitOutputData%WaveElevC0,2) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveElevC0)) THEN + ALLOCATE(DstInitOutputData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveElevC0 = SrcInitOutputData%WaveElevC0 +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveDirArr)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveDirArr,1) + i1_u = UBOUND(SrcInitOutputData%WaveDirArr,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveDirArr)) THEN + ALLOCATE(DstInitOutputData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveDirArr = SrcInitOutputData%WaveDirArr +ENDIF + DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin + DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax + DstInitOutputData%WaveDir = SrcInitOutputData%WaveDir + DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir + DstInitOutputData%WaveMultiDir = SrcInitOutputData%WaveMultiDir + DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega +IF (ALLOCATED(SrcInitOutputData%WaveKinzi)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveKinzi,1) + i1_u = UBOUND(SrcInitOutputData%WaveKinzi,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveKinzi)) THEN + ALLOCATE(DstInitOutputData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveKinzi = SrcInitOutputData%WaveKinzi +ENDIF +IF (ALLOCATED(SrcInitOutputData%PWaveDynP0)) THEN + i1_l = LBOUND(SrcInitOutputData%PWaveDynP0,1) + i1_u = UBOUND(SrcInitOutputData%PWaveDynP0,1) + i2_l = LBOUND(SrcInitOutputData%PWaveDynP0,2) + i2_u = UBOUND(SrcInitOutputData%PWaveDynP0,2) + IF (.NOT. ALLOCATED(DstInitOutputData%PWaveDynP0)) THEN + ALLOCATE(DstInitOutputData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%PWaveDynP0 = SrcInitOutputData%PWaveDynP0 +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveDynP)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveDynP,1) + i1_u = UBOUND(SrcInitOutputData%WaveDynP,1) + i2_l = LBOUND(SrcInitOutputData%WaveDynP,2) + i2_u = UBOUND(SrcInitOutputData%WaveDynP,2) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP)) THEN + ALLOCATE(DstInitOutputData%WaveDynP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveDynP = SrcInitOutputData%WaveDynP +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveAcc)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveAcc,1) + i1_u = UBOUND(SrcInitOutputData%WaveAcc,1) + i2_l = LBOUND(SrcInitOutputData%WaveAcc,2) + i2_u = UBOUND(SrcInitOutputData%WaveAcc,2) + i3_l = LBOUND(SrcInitOutputData%WaveAcc,3) + i3_u = UBOUND(SrcInitOutputData%WaveAcc,3) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc)) THEN + ALLOCATE(DstInitOutputData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveAcc = SrcInitOutputData%WaveAcc +ENDIF +IF (ALLOCATED(SrcInitOutputData%PWaveAcc0)) THEN + i1_l = LBOUND(SrcInitOutputData%PWaveAcc0,1) + i1_u = UBOUND(SrcInitOutputData%PWaveAcc0,1) + i2_l = LBOUND(SrcInitOutputData%PWaveAcc0,2) + i2_u = UBOUND(SrcInitOutputData%PWaveAcc0,2) + i3_l = LBOUND(SrcInitOutputData%PWaveAcc0,3) + i3_u = UBOUND(SrcInitOutputData%PWaveAcc0,3) + IF (.NOT. ALLOCATED(DstInitOutputData%PWaveAcc0)) THEN + ALLOCATE(DstInitOutputData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%PWaveAcc0 = SrcInitOutputData%PWaveAcc0 +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveVel)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveVel,1) + i1_u = UBOUND(SrcInitOutputData%WaveVel,1) + i2_l = LBOUND(SrcInitOutputData%WaveVel,2) + i2_u = UBOUND(SrcInitOutputData%WaveVel,2) + i3_l = LBOUND(SrcInitOutputData%WaveVel,3) + i3_u = UBOUND(SrcInitOutputData%WaveVel,3) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel)) THEN + ALLOCATE(DstInitOutputData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveVel = SrcInitOutputData%WaveVel +ENDIF +IF (ALLOCATED(SrcInitOutputData%PWaveVel0)) THEN + i1_l = LBOUND(SrcInitOutputData%PWaveVel0,1) + i1_u = UBOUND(SrcInitOutputData%PWaveVel0,1) + i2_l = LBOUND(SrcInitOutputData%PWaveVel0,2) + i2_u = UBOUND(SrcInitOutputData%PWaveVel0,2) + i3_l = LBOUND(SrcInitOutputData%PWaveVel0,3) + i3_u = UBOUND(SrcInitOutputData%PWaveVel0,3) + IF (.NOT. ALLOCATED(DstInitOutputData%PWaveVel0)) THEN + ALLOCATE(DstInitOutputData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%PWaveVel0 = SrcInitOutputData%PWaveVel0 +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveElev)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveElev,1) + i1_u = UBOUND(SrcInitOutputData%WaveElev,1) + i2_l = LBOUND(SrcInitOutputData%WaveElev,2) + i2_u = UBOUND(SrcInitOutputData%WaveElev,2) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveElev)) THEN + ALLOCATE(DstInitOutputData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElev.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveElev = SrcInitOutputData%WaveElev +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveElev0)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveElev0,1) + i1_u = UBOUND(SrcInitOutputData%WaveElev0,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveElev0)) THEN + ALLOCATE(DstInitOutputData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElev0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveElev0 = SrcInitOutputData%WaveElev0 +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveElevMD)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveElevMD,1) + i1_u = UBOUND(SrcInitOutputData%WaveElevMD,1) + i2_l = LBOUND(SrcInitOutputData%WaveElevMD,2) + i2_u = UBOUND(SrcInitOutputData%WaveElevMD,2) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveElevMD)) THEN + ALLOCATE(DstInitOutputData%WaveElevMD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevMD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveElevMD = SrcInitOutputData%WaveElevMD +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveElevSeries)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveElevSeries,1) + i1_u = UBOUND(SrcInitOutputData%WaveElevSeries,1) + i2_l = LBOUND(SrcInitOutputData%WaveElevSeries,2) + i2_u = UBOUND(SrcInitOutputData%WaveElevSeries,2) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveElevSeries)) THEN + ALLOCATE(DstInitOutputData%WaveElevSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevSeries.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveElevSeries = SrcInitOutputData%WaveElevSeries +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveTime)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveTime,1) + i1_u = UBOUND(SrcInitOutputData%WaveTime,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveTime)) THEN + ALLOCATE(DstInitOutputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveTime.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveTime = SrcInitOutputData%WaveTime +ENDIF + DstInitOutputData%WaveTMax = SrcInitOutputData%WaveTMax +IF (ALLOCATED(SrcInitOutputData%nodeInWater)) THEN + i1_l = LBOUND(SrcInitOutputData%nodeInWater,1) + i1_u = UBOUND(SrcInitOutputData%nodeInWater,1) + i2_l = LBOUND(SrcInitOutputData%nodeInWater,2) + i2_u = UBOUND(SrcInitOutputData%nodeInWater,2) + IF (.NOT. ALLOCATED(DstInitOutputData%nodeInWater)) THEN + ALLOCATE(DstInitOutputData%nodeInWater(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%nodeInWater.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%nodeInWater = SrcInitOutputData%nodeInWater +ENDIF + DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg + DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave + DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 + END SUBROUTINE Waves_CopyInitOutput + + SUBROUTINE Waves_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyInitOutput' + + ErrStat = ErrID_None + ErrMsg = "" + +IF (ALLOCATED(InitOutputData%WaveElevC0)) THEN + DEALLOCATE(InitOutputData%WaveElevC0) +ENDIF +IF (ALLOCATED(InitOutputData%WaveDirArr)) THEN + DEALLOCATE(InitOutputData%WaveDirArr) +ENDIF +IF (ALLOCATED(InitOutputData%WaveKinzi)) THEN + DEALLOCATE(InitOutputData%WaveKinzi) +ENDIF +IF (ALLOCATED(InitOutputData%PWaveDynP0)) THEN + DEALLOCATE(InitOutputData%PWaveDynP0) +ENDIF +IF (ALLOCATED(InitOutputData%WaveDynP)) THEN + DEALLOCATE(InitOutputData%WaveDynP) +ENDIF +IF (ALLOCATED(InitOutputData%WaveAcc)) THEN + DEALLOCATE(InitOutputData%WaveAcc) +ENDIF +IF (ALLOCATED(InitOutputData%PWaveAcc0)) THEN + DEALLOCATE(InitOutputData%PWaveAcc0) +ENDIF +IF (ALLOCATED(InitOutputData%WaveVel)) THEN + DEALLOCATE(InitOutputData%WaveVel) +ENDIF +IF (ALLOCATED(InitOutputData%PWaveVel0)) THEN + DEALLOCATE(InitOutputData%PWaveVel0) +ENDIF +IF (ALLOCATED(InitOutputData%WaveElev)) THEN + DEALLOCATE(InitOutputData%WaveElev) +ENDIF +IF (ALLOCATED(InitOutputData%WaveElev0)) THEN + DEALLOCATE(InitOutputData%WaveElev0) +ENDIF +IF (ALLOCATED(InitOutputData%WaveElevMD)) THEN + DEALLOCATE(InitOutputData%WaveElevMD) +ENDIF +IF (ALLOCATED(InitOutputData%WaveElevSeries)) THEN + DEALLOCATE(InitOutputData%WaveElevSeries) +ENDIF +IF (ALLOCATED(InitOutputData%WaveTime)) THEN + DEALLOCATE(InitOutputData%WaveTime) +ENDIF +IF (ALLOCATED(InitOutputData%nodeInWater)) THEN + DEALLOCATE(InitOutputData%nodeInWater) +ENDIF + END SUBROUTINE Waves_DestroyInitOutput + + SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves_InitOutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackInitOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! WaveElevC0 allocated yes/no + IF ( ALLOCATED(InData%WaveElevC0) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WaveElevC0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC0) ! WaveElevC0 + END IF + Int_BufSz = Int_BufSz + 1 ! WaveDirArr allocated yes/no + IF ( ALLOCATED(InData%WaveDirArr) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveDirArr upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveDirArr) ! WaveDirArr + END IF + Re_BufSz = Re_BufSz + 1 ! WaveDirMin + Re_BufSz = Re_BufSz + 1 ! WaveDirMax + Re_BufSz = Re_BufSz + 1 ! WaveDir + Int_BufSz = Int_BufSz + 1 ! WaveNDir + Int_BufSz = Int_BufSz + 1 ! WaveMultiDir + Re_BufSz = Re_BufSz + 1 ! WaveDOmega + Int_BufSz = Int_BufSz + 1 ! WaveKinzi allocated yes/no + IF ( ALLOCATED(InData%WaveKinzi) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveKinzi upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveKinzi) ! WaveKinzi + END IF + Int_BufSz = Int_BufSz + 1 ! PWaveDynP0 allocated yes/no + IF ( ALLOCATED(InData%PWaveDynP0) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PWaveDynP0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PWaveDynP0) ! PWaveDynP0 + END IF + Int_BufSz = Int_BufSz + 1 ! WaveDynP allocated yes/no + IF ( ALLOCATED(InData%WaveDynP) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WaveDynP upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP) ! WaveDynP + END IF + Int_BufSz = Int_BufSz + 1 ! WaveAcc allocated yes/no + IF ( ALLOCATED(InData%WaveAcc) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! WaveAcc upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc) ! WaveAcc + END IF + Int_BufSz = Int_BufSz + 1 ! PWaveAcc0 allocated yes/no + IF ( ALLOCATED(InData%PWaveAcc0) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! PWaveAcc0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PWaveAcc0) ! PWaveAcc0 + END IF + Int_BufSz = Int_BufSz + 1 ! WaveVel allocated yes/no + IF ( ALLOCATED(InData%WaveVel) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! WaveVel upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveVel) ! WaveVel + END IF + Int_BufSz = Int_BufSz + 1 ! PWaveVel0 allocated yes/no + IF ( ALLOCATED(InData%PWaveVel0) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! PWaveVel0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PWaveVel0) ! PWaveVel0 + END IF + Int_BufSz = Int_BufSz + 1 ! WaveElev allocated yes/no + IF ( ALLOCATED(InData%WaveElev) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WaveElev upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElev) ! WaveElev + END IF + Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no + IF ( ALLOCATED(InData%WaveElev0) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 + END IF + Int_BufSz = Int_BufSz + 1 ! WaveElevMD allocated yes/no + IF ( ALLOCATED(InData%WaveElevMD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WaveElevMD upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElevMD) ! WaveElevMD + END IF + Int_BufSz = Int_BufSz + 1 ! WaveElevSeries allocated yes/no + IF ( ALLOCATED(InData%WaveElevSeries) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WaveElevSeries upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElevSeries) ! WaveElevSeries + END IF + Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no + IF ( ALLOCATED(InData%WaveTime) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime + END IF + Db_BufSz = Db_BufSz + 1 ! WaveTMax + Int_BufSz = Int_BufSz + 1 ! nodeInWater allocated yes/no + IF ( ALLOCATED(InData%nodeInWater) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! nodeInWater upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%nodeInWater) ! nodeInWater + END IF + Re_BufSz = Re_BufSz + 1 ! RhoXg + Int_BufSz = Int_BufSz + 1 ! NStepWave + Int_BufSz = Int_BufSz + 1 ! NStepWave2 + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%WaveElevC0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) + DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) + ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDirArr,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) + ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%WaveDirMin + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirMax + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveNDir + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDOmega + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinzi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PWaveDynP0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PWaveDynP0,2), UBOUND(InData%PWaveDynP0,2) + DO i1 = LBOUND(InData%PWaveDynP0,1), UBOUND(InData%PWaveDynP0,1) + ReKiBuf(Re_Xferred) = InData%PWaveDynP0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveDynP) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) + DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveAcc) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) + DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) + DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PWaveAcc0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%PWaveAcc0,3), UBOUND(InData%PWaveAcc0,3) + DO i2 = LBOUND(InData%PWaveAcc0,2), UBOUND(InData%PWaveAcc0,2) + DO i1 = LBOUND(InData%PWaveAcc0,1), UBOUND(InData%PWaveAcc0,1) + ReKiBuf(Re_Xferred) = InData%PWaveAcc0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) + DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) + DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) + ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PWaveVel0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%PWaveVel0,3), UBOUND(InData%PWaveVel0,3) + DO i2 = LBOUND(InData%PWaveVel0,2), UBOUND(InData%PWaveVel0,2) + DO i1 = LBOUND(InData%PWaveVel0,1), UBOUND(InData%PWaveVel0,1) + ReKiBuf(Re_Xferred) = InData%PWaveVel0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) + DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) + ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) + ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveElevMD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevMD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevMD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevMD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevMD,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WaveElevMD,2), UBOUND(InData%WaveElevMD,2) + DO i1 = LBOUND(InData%WaveElevMD,1), UBOUND(InData%WaveElevMD,1) + ReKiBuf(Re_Xferred) = InData%WaveElevMD(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveElevSeries) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WaveElevSeries,2), UBOUND(InData%WaveElevSeries,2) + DO i1 = LBOUND(InData%WaveElevSeries,1), UBOUND(InData%WaveElevSeries,1) + ReKiBuf(Re_Xferred) = InData%WaveElevSeries(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + DbKiBuf(Db_Xferred) = InData%WaveTMax + Db_Xferred = Db_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%nodeInWater) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%nodeInWater,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%nodeInWater,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%nodeInWater,2), UBOUND(InData%nodeInWater,2) + DO i1 = LBOUND(InData%nodeInWater,1), UBOUND(InData%nodeInWater,1) + IntKiBuf(Int_Xferred) = InData%nodeInWater(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + ReKiBuf(Re_Xferred) = InData%RhoXg + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave2 + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Waves_PackInitOutput + + SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves_InitOutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackInitOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElevC0)) DEALLOCATE(OutData%WaveElevC0) + ALLOCATE(OutData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) + DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) + OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveDirArr)) DEALLOCATE(OutData%WaveDirArr) + ALLOCATE(OutData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) + OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveNDir = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveKinzi)) DEALLOCATE(OutData%WaveKinzi) + ALLOCATE(OutData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) + OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveDynP0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PWaveDynP0)) DEALLOCATE(OutData%PWaveDynP0) + ALLOCATE(OutData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PWaveDynP0,2), UBOUND(OutData%PWaveDynP0,2) + DO i1 = LBOUND(OutData%PWaveDynP0,1), UBOUND(OutData%PWaveDynP0,1) + OutData%PWaveDynP0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveDynP)) DEALLOCATE(OutData%WaveDynP) + ALLOCATE(OutData%WaveDynP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) + DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) + OutData%WaveDynP(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveAcc)) DEALLOCATE(OutData%WaveAcc) + ALLOCATE(OutData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) + DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) + DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) + OutData%WaveAcc(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAcc0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PWaveAcc0)) DEALLOCATE(OutData%PWaveAcc0) + ALLOCATE(OutData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%PWaveAcc0,3), UBOUND(OutData%PWaveAcc0,3) + DO i2 = LBOUND(OutData%PWaveAcc0,2), UBOUND(OutData%PWaveAcc0,2) + DO i1 = LBOUND(OutData%PWaveAcc0,1), UBOUND(OutData%PWaveAcc0,1) + OutData%PWaveAcc0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveVel)) DEALLOCATE(OutData%WaveVel) + ALLOCATE(OutData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) + DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) + DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) + OutData%WaveVel(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveVel0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PWaveVel0)) DEALLOCATE(OutData%PWaveVel0) + ALLOCATE(OutData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%PWaveVel0,3), UBOUND(OutData%PWaveVel0,3) + DO i2 = LBOUND(OutData%PWaveVel0,2), UBOUND(OutData%PWaveVel0,2) + DO i1 = LBOUND(OutData%PWaveVel0,1), UBOUND(OutData%PWaveVel0,1) + OutData%PWaveVel0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElev)) DEALLOCATE(OutData%WaveElev) + ALLOCATE(OutData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) + DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) + OutData%WaveElev(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElev0)) DEALLOCATE(OutData%WaveElev0) + ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) + OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevMD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElevMD)) DEALLOCATE(OutData%WaveElevMD) + ALLOCATE(OutData%WaveElevMD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevMD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WaveElevMD,2), UBOUND(OutData%WaveElevMD,2) + DO i1 = LBOUND(OutData%WaveElevMD,1), UBOUND(OutData%WaveElevMD,1) + OutData%WaveElevMD(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevSeries not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElevSeries)) DEALLOCATE(OutData%WaveElevSeries) + ALLOCATE(OutData%WaveElevSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WaveElevSeries,2), UBOUND(OutData%WaveElevSeries,2) + DO i1 = LBOUND(OutData%WaveElevSeries,1), UBOUND(OutData%WaveElevSeries,1) + OutData%WaveElevSeries(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) + ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%WaveTMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nodeInWater not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%nodeInWater)) DEALLOCATE(OutData%nodeInWater) + ALLOCATE(OutData%nodeInWater(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%nodeInWater,2), UBOUND(OutData%nodeInWater,2) + DO i1 = LBOUND(OutData%nodeInWater,1), UBOUND(OutData%nodeInWater,1) + OutData%nodeInWater(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + OutData%RhoXg = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Waves_UnPackInitOutput + + SUBROUTINE Waves_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves_ContinuousStateType), INTENT(IN) :: SrcContStateData + TYPE(Waves_ContinuousStateType), INTENT(INOUT) :: DstContStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyContState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstContStateData%DummyContState = SrcContStateData%DummyContState + END SUBROUTINE Waves_CopyContState + + SUBROUTINE Waves_DestroyContState( ContStateData, ErrStat, ErrMsg ) + TYPE(Waves_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyContState' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Waves_DestroyContState + + SUBROUTINE Waves_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves_ContinuousStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackContState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyContState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Waves_PackContState + + SUBROUTINE Waves_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves_ContinuousStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackContState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Waves_UnPackContState + + SUBROUTINE Waves_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves_DiscreteStateType), INTENT(IN) :: SrcDiscStateData + TYPE(Waves_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyDiscState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState + END SUBROUTINE Waves_CopyDiscState + + SUBROUTINE Waves_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + TYPE(Waves_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyDiscState' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Waves_DestroyDiscState + + SUBROUTINE Waves_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves_DiscreteStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackDiscState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyDiscState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Waves_PackDiscState + + SUBROUTINE Waves_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves_DiscreteStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackDiscState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Waves_UnPackDiscState + + SUBROUTINE Waves_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves_ConstraintStateType), INTENT(IN) :: SrcConstrStateData + TYPE(Waves_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyConstrState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState + END SUBROUTINE Waves_CopyConstrState + + SUBROUTINE Waves_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + TYPE(Waves_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyConstrState' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Waves_DestroyConstrState + + SUBROUTINE Waves_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves_ConstraintStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackConstrState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyConstrState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Waves_PackConstrState + + SUBROUTINE Waves_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves_ConstraintStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackConstrState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Waves_UnPackConstrState + + SUBROUTINE Waves_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves_OtherStateType), INTENT(IN) :: SrcOtherStateData + TYPE(Waves_OtherStateType), INTENT(INOUT) :: DstOtherStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyOtherState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState + END SUBROUTINE Waves_CopyOtherState + + SUBROUTINE Waves_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + TYPE(Waves_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyOtherState' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Waves_DestroyOtherState + + SUBROUTINE Waves_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves_OtherStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackOtherState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! DummyOtherState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Waves_PackOtherState + + SUBROUTINE Waves_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves_OtherStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackOtherState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Waves_UnPackOtherState + + SUBROUTINE Waves_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves_MiscVarType), INTENT(IN) :: SrcMiscData + TYPE(Waves_MiscVarType), INTENT(INOUT) :: DstMiscData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyMisc' +! + ErrStat = ErrID_None + ErrMsg = "" + DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar + END SUBROUTINE Waves_CopyMisc + + SUBROUTINE Waves_DestroyMisc( MiscData, ErrStat, ErrMsg ) + TYPE(Waves_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyMisc' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Waves_DestroyMisc + + SUBROUTINE Waves_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves_MiscVarType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackMisc' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! DummyMiscVar + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = InData%DummyMiscVar + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Waves_PackMisc + + SUBROUTINE Waves_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves_MiscVarType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackMisc' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyMiscVar = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Waves_UnPackMisc + + SUBROUTINE Waves_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves_ParameterType), INTENT(IN) :: SrcParamData + TYPE(Waves_ParameterType), INTENT(INOUT) :: DstParamData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyParam' +! + ErrStat = ErrID_None + ErrMsg = "" + DstParamData%DT = SrcParamData%DT + DstParamData%WaveTMax = SrcParamData%WaveTMax + DstParamData%NStepWave = SrcParamData%NStepWave + DstParamData%WaveNDir = SrcParamData%WaveNDir + DstParamData%WaveMultiDir = SrcParamData%WaveMultiDir + END SUBROUTINE Waves_CopyParam + + SUBROUTINE Waves_DestroyParam( ParamData, ErrStat, ErrMsg ) + TYPE(Waves_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyParam' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Waves_DestroyParam + + SUBROUTINE Waves_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves_ParameterType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackParam' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Db_BufSz = Db_BufSz + 1 ! DT + Db_BufSz = Db_BufSz + 1 ! WaveTMax + Int_BufSz = Int_BufSz + 1 ! NStepWave + Int_BufSz = Int_BufSz + 1 ! WaveNDir + Int_BufSz = Int_BufSz + 1 ! WaveMultiDir + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%WaveTMax + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveNDir + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Waves_PackParam + + SUBROUTINE Waves_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves_ParameterType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackParam' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WaveTMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveNDir = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Waves_UnPackParam + + SUBROUTINE Waves_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves_InputType), INTENT(IN) :: SrcInputData + TYPE(Waves_InputType), INTENT(INOUT) :: DstInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyInput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInputData%DummyInput = SrcInputData%DummyInput + END SUBROUTINE Waves_CopyInput + + SUBROUTINE Waves_DestroyInput( InputData, ErrStat, ErrMsg ) + TYPE(Waves_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyInput' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Waves_DestroyInput + + SUBROUTINE Waves_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves_InputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyInput + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyInput + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Waves_PackInput + + SUBROUTINE Waves_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves_InputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyInput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Waves_UnPackInput + + SUBROUTINE Waves_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Waves_OutputType), INTENT(IN) :: SrcOutputData + TYPE(Waves_OutputType), INTENT(INOUT) :: DstOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyOutput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstOutputData%DummyOutput = SrcOutputData%DummyOutput + END SUBROUTINE Waves_CopyOutput + + SUBROUTINE Waves_DestroyOutput( OutputData, ErrStat, ErrMsg ) + TYPE(Waves_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyOutput' + + ErrStat = ErrID_None + ErrMsg = "" + + END SUBROUTINE Waves_DestroyOutput + + SUBROUTINE Waves_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(Waves_OutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyOutput + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyOutput + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Waves_PackOutput + + SUBROUTINE Waves_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(Waves_OutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyOutput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE Waves_UnPackOutput + + + SUBROUTINE Waves_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(Waves_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs + TYPE(Waves_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Input_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .ne. size(u)) then + CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) + RETURN + endif + order = SIZE(u) - 1 + IF ( order .eq. 0 ) THEN + CALL Waves_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL Waves_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 2 ) THEN + CALL Waves_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE + CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) + RETURN + ENDIF + END SUBROUTINE Waves_Input_ExtrapInterp + + + SUBROUTINE Waves_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = u1, f(t2) = u2 +! +!.................................................................................................................................. + + TYPE(Waves_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(Waves_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(Waves_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Input_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) + b = -(u1%DummyInput - u2%DummyInput) + u_out%DummyInput = u1%DummyInput + b * ScaleFactor + END SUBROUTINE Waves_Input_ExtrapInterp1 + + + SUBROUTINE Waves_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 +! +!.................................................................................................................................. + + TYPE(Waves_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(Waves_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(Waves_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(Waves_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Input_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor + c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor + u_out%DummyInput = u1%DummyInput + b + c * t_out + END SUBROUTINE Waves_Input_ExtrapInterp2 + + + SUBROUTINE Waves_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(Waves_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs + TYPE(Waves_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Output_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .ne. size(y)) then + CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) + RETURN + endif + order = SIZE(y) - 1 + IF ( order .eq. 0 ) THEN + CALL Waves_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL Waves_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 2 ) THEN + CALL Waves_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE + CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) + RETURN + ENDIF + END SUBROUTINE Waves_Output_ExtrapInterp + + + SUBROUTINE Waves_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = y1, f(t2) = y2 +! +!.................................................................................................................................. + + TYPE(Waves_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(Waves_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(Waves_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Output_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) + b = -(y1%DummyOutput - y2%DummyOutput) + y_out%DummyOutput = y1%DummyOutput + b * ScaleFactor + END SUBROUTINE Waves_Output_ExtrapInterp1 + + + SUBROUTINE Waves_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 +! +!.................................................................................................................................. + + TYPE(Waves_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(Waves_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(Waves_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(Waves_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Output_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))* scaleFactor + c = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) * scaleFactor + y_out%DummyOutput = y1%DummyOutput + b + c * t_out + END SUBROUTINE Waves_Output_ExtrapInterp2 + +END MODULE Waves_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index f3c98e47c4..52db504a7e 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -335,14 +335,12 @@ SUBROUTINE IceD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%FspN = SrcInputFileData%FspN END SUBROUTINE IceD_CopyInputFile - SUBROUTINE IceD_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) TYPE(IceD_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyInputFile' @@ -350,12 +348,6 @@ SUBROUTINE IceD_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputFileData%LegPosX)) THEN DEALLOCATE(InputFileData%LegPosX) ENDIF @@ -882,14 +874,12 @@ SUBROUTINE IceD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%TMax = SrcInitInputData%TMax END SUBROUTINE IceD_CopyInitInput - SUBROUTINE IceD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(IceD_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyInitInput' @@ -897,12 +887,6 @@ SUBROUTINE IceD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE IceD_DestroyInitInput SUBROUTINE IceD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1085,14 +1069,12 @@ SUBROUTINE IceD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE IceD_CopyInitOutput - SUBROUTINE IceD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(IceD_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyInitOutput' @@ -1100,19 +1082,13 @@ SUBROUTINE IceD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) ENDIF IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN DEALLOCATE(InitOutputData%WriteOutputUnt) ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE IceD_DestroyInitOutput @@ -1164,7 +1140,7 @@ SUBROUTINE IceD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_BufSz = Int_BufSz + 1 ! numLegs ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1243,7 +1219,7 @@ SUBROUTINE IceD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err END IF IntKiBuf(Int_Xferred) = InData%numLegs Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1375,7 +1351,7 @@ SUBROUTINE IceD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1402,14 +1378,12 @@ SUBROUTINE IceD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Err DstContStateData%dqdt = SrcContStateData%dqdt END SUBROUTINE IceD_CopyContState - SUBROUTINE IceD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceD_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(IceD_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyContState' @@ -1417,12 +1391,6 @@ SUBROUTINE IceD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE IceD_DestroyContState SUBROUTINE IceD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1544,14 +1512,12 @@ SUBROUTINE IceD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Err DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE IceD_CopyDiscState - SUBROUTINE IceD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(IceD_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyDiscState' @@ -1559,12 +1525,6 @@ SUBROUTINE IceD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE IceD_DestroyDiscState SUBROUTINE IceD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1681,14 +1641,12 @@ SUBROUTINE IceD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCod DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE IceD_CopyConstrState - SUBROUTINE IceD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(IceD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyConstrState' @@ -1696,12 +1654,6 @@ SUBROUTINE IceD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE IceD_DestroyConstrState SUBROUTINE IceD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1876,14 +1828,12 @@ SUBROUTINE IceD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, DstOtherStateData%n = SrcOtherStateData%n END SUBROUTINE IceD_CopyOtherState - SUBROUTINE IceD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(IceD_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyOtherState' @@ -1891,12 +1841,6 @@ SUBROUTINE IceD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OtherStateData%Nc)) THEN DEALLOCATE(OtherStateData%Nc) ENDIF @@ -1908,7 +1852,7 @@ SUBROUTINE IceD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpo ENDIF IF (ALLOCATED(OtherStateData%xdot)) THEN DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL IceD_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceD_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OtherStateData%xdot) @@ -2290,14 +2234,12 @@ SUBROUTINE IceD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar END SUBROUTINE IceD_CopyMisc - SUBROUTINE IceD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceD_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(IceD_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyMisc' @@ -2305,12 +2247,6 @@ SUBROUTINE IceD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE IceD_DestroyMisc SUBROUTINE IceD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2595,14 +2531,12 @@ SUBROUTINE IceD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%Fsp = SrcParamData%Fsp END SUBROUTINE IceD_CopyParam - SUBROUTINE IceD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceD_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(IceD_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyParam' @@ -2610,12 +2544,6 @@ SUBROUTINE IceD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%OutName)) THEN DEALLOCATE(ParamData%OutName) ENDIF @@ -3392,14 +3320,12 @@ SUBROUTINE IceD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE IceD_CopyInput - SUBROUTINE IceD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceD_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(IceD_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyInput' @@ -3407,12 +3333,6 @@ SUBROUTINE IceD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( InputData%PointMesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE IceD_DestroyInput @@ -3627,14 +3547,12 @@ SUBROUTINE IceD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err ENDIF END SUBROUTINE IceD_CopyOutput - SUBROUTINE IceD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceD_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(IceD_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyOutput' @@ -3642,12 +3560,6 @@ SUBROUTINE IceD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( OutputData%PointMesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(OutputData%WriteOutput)) THEN diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index 1fea1d5380..c010436746 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -117,8 +117,6 @@ SUBROUTINE IceFloe_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_CopyInitInput' @@ -132,14 +130,12 @@ SUBROUTINE IceFloe_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%RootName = SrcInitInputData%RootName END SUBROUTINE IceFloe_CopyInitInput - SUBROUTINE IceFloe_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceFloe_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(IceFloe_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyInitInput' @@ -147,12 +143,6 @@ SUBROUTINE IceFloe_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE IceFloe_DestroyInitInput SUBROUTINE IceFloe_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -251,8 +241,6 @@ SUBROUTINE IceFloe_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackInitInput' @@ -326,14 +314,12 @@ SUBROUTINE IceFloe_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCod IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE IceFloe_CopyInitOutput - SUBROUTINE IceFloe_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceFloe_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(IceFloe_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyInitOutput' @@ -341,19 +327,13 @@ SUBROUTINE IceFloe_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCAT ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) ENDIF IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN DEALLOCATE(InitOutputData%WriteOutputUnt) ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE IceFloe_DestroyInitOutput @@ -404,7 +384,7 @@ SUBROUTINE IceFloe_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -481,7 +461,7 @@ SUBROUTINE IceFloe_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END DO ! I END DO END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -611,7 +591,7 @@ SUBROUTINE IceFloe_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -637,14 +617,12 @@ SUBROUTINE IceFloe_CopyContState( SrcContStateData, DstContStateData, CtrlCode, DstContStateData%DummyContStateVar = SrcContStateData%DummyContStateVar END SUBROUTINE IceFloe_CopyContState - SUBROUTINE IceFloe_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceFloe_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(IceFloe_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyContState' @@ -652,12 +630,6 @@ SUBROUTINE IceFloe_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE IceFloe_DestroyContState SUBROUTINE IceFloe_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -774,14 +746,12 @@ SUBROUTINE IceFloe_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, DstDiscStateData%DummyDiscStateVar = SrcDiscStateData%DummyDiscStateVar END SUBROUTINE IceFloe_CopyDiscState - SUBROUTINE IceFloe_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceFloe_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(IceFloe_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyDiscState' @@ -789,12 +759,6 @@ SUBROUTINE IceFloe_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE IceFloe_DestroyDiscState SUBROUTINE IceFloe_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -911,14 +875,12 @@ SUBROUTINE IceFloe_CopyConstrState( SrcConstrStateData, DstConstrStateData, Ctrl DstConstrStateData%DummyConstrStateVar = SrcConstrStateData%DummyConstrStateVar END SUBROUTINE IceFloe_CopyConstrState - SUBROUTINE IceFloe_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceFloe_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(IceFloe_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyConstrState' @@ -926,12 +888,6 @@ SUBROUTINE IceFloe_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOC ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE IceFloe_DestroyConstrState SUBROUTINE IceFloe_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1048,14 +1004,12 @@ SUBROUTINE IceFloe_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCod DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState END SUBROUTINE IceFloe_CopyOtherState - SUBROUTINE IceFloe_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceFloe_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(IceFloe_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyOtherState' @@ -1063,12 +1017,6 @@ SUBROUTINE IceFloe_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCAT ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE IceFloe_DestroyOtherState SUBROUTINE IceFloe_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1185,14 +1133,12 @@ SUBROUTINE IceFloe_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar END SUBROUTINE IceFloe_CopyMisc - SUBROUTINE IceFloe_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceFloe_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(IceFloe_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyMisc' @@ -1200,12 +1146,6 @@ SUBROUTINE IceFloe_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE IceFloe_DestroyMisc SUBROUTINE IceFloe_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1388,14 +1328,12 @@ SUBROUTINE IceFloe_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%initFlag = SrcParamData%initFlag END SUBROUTINE IceFloe_CopyParam - SUBROUTINE IceFloe_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceFloe_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(IceFloe_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyParam' @@ -1403,12 +1341,6 @@ SUBROUTINE IceFloe_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%loadSeries)) THEN DEALLOCATE(ParamData%loadSeries) ENDIF @@ -1773,14 +1705,12 @@ SUBROUTINE IceFloe_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE IceFloe_CopyInput - SUBROUTINE IceFloe_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceFloe_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(IceFloe_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyInput' @@ -1788,12 +1718,6 @@ SUBROUTINE IceFloe_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( InputData%iceMesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE IceFloe_DestroyInput @@ -2008,14 +1932,12 @@ SUBROUTINE IceFloe_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ENDIF END SUBROUTINE IceFloe_CopyOutput - SUBROUTINE IceFloe_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IceFloe_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(IceFloe_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyOutput' @@ -2023,12 +1945,6 @@ SUBROUTINE IceFloe_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointer ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( OutputData%iceMesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(OutputData%WriteOutput)) THEN diff --git a/modules/inflowwind/src/IfW_FlowField_Types.f90 b/modules/inflowwind/src/IfW_FlowField_Types.f90 index c8a8055785..11d0acc220 100644 --- a/modules/inflowwind/src/IfW_FlowField_Types.f90 +++ b/modules/inflowwind/src/IfW_FlowField_Types.f90 @@ -175,10 +175,6 @@ SUBROUTINE IfW_FlowField_CopyUniformFieldType( SrcUniformFieldTypeData, DstUnifo ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_CopyUniformFieldType' @@ -394,14 +390,12 @@ SUBROUTINE IfW_FlowField_CopyUniformFieldType( SrcUniformFieldTypeData, DstUnifo ENDIF END SUBROUTINE IfW_FlowField_CopyUniformFieldType - SUBROUTINE IfW_FlowField_DestroyUniformFieldType( UniformFieldTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IfW_FlowField_DestroyUniformFieldType( UniformFieldTypeData, ErrStat, ErrMsg ) TYPE(UniformFieldType), INTENT(INOUT) :: UniformFieldTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyUniformFieldType' @@ -409,12 +403,6 @@ SUBROUTINE IfW_FlowField_DestroyUniformFieldType( UniformFieldTypeData, ErrStat, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(UniformFieldTypeData%Time)) THEN DEALLOCATE(UniformFieldTypeData%Time) ENDIF @@ -895,10 +883,6 @@ SUBROUTINE IfW_FlowField_UnPackUniformFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Out INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_UnPackUniformFieldType' @@ -1262,14 +1246,12 @@ SUBROUTINE IfW_FlowField_CopyUniformField_Interp( SrcUniformField_InterpData, Ds DstUniformField_InterpData%SinAngleV = SrcUniformField_InterpData%SinAngleV END SUBROUTINE IfW_FlowField_CopyUniformField_Interp - SUBROUTINE IfW_FlowField_DestroyUniformField_Interp( UniformField_InterpData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IfW_FlowField_DestroyUniformField_Interp( UniformField_InterpData, ErrStat, ErrMsg ) TYPE(UniformField_Interp), INTENT(INOUT) :: UniformField_InterpData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyUniformField_Interp' @@ -1277,12 +1259,6 @@ SUBROUTINE IfW_FlowField_DestroyUniformField_Interp( UniformField_InterpData, Er ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE IfW_FlowField_DestroyUniformField_Interp SUBROUTINE IfW_FlowField_PackUniformField_Interp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1627,14 +1603,12 @@ SUBROUTINE IfW_FlowField_CopyGrid3DFieldType( SrcGrid3DFieldTypeData, DstGrid3DF DstGrid3DFieldTypeData%BoxExceedWarned = SrcGrid3DFieldTypeData%BoxExceedWarned END SUBROUTINE IfW_FlowField_CopyGrid3DFieldType - SUBROUTINE IfW_FlowField_DestroyGrid3DFieldType( Grid3DFieldTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IfW_FlowField_DestroyGrid3DFieldType( Grid3DFieldTypeData, ErrStat, ErrMsg ) TYPE(Grid3DFieldType), INTENT(INOUT) :: Grid3DFieldTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyGrid3DFieldType' @@ -1642,12 +1616,6 @@ SUBROUTINE IfW_FlowField_DestroyGrid3DFieldType( Grid3DFieldTypeData, ErrStat, E ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(Grid3DFieldTypeData%Vel)) THEN DEALLOCATE(Grid3DFieldTypeData%Vel) ENDIF @@ -2328,14 +2296,12 @@ SUBROUTINE IfW_FlowField_CopyGrid4DFieldType( SrcGrid4DFieldTypeData, DstGrid4DF DstGrid4DFieldTypeData%RefHeight = SrcGrid4DFieldTypeData%RefHeight END SUBROUTINE IfW_FlowField_CopyGrid4DFieldType - SUBROUTINE IfW_FlowField_DestroyGrid4DFieldType( Grid4DFieldTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IfW_FlowField_DestroyGrid4DFieldType( Grid4DFieldTypeData, ErrStat, ErrMsg ) TYPE(Grid4DFieldType), INTENT(INOUT) :: Grid4DFieldTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyGrid4DFieldType' @@ -2343,12 +2309,6 @@ SUBROUTINE IfW_FlowField_DestroyGrid4DFieldType( Grid4DFieldTypeData, ErrStat, E ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(Grid4DFieldTypeData%Vel)) THEN DEALLOCATE(Grid4DFieldTypeData%Vel) ENDIF @@ -2604,14 +2564,12 @@ SUBROUTINE IfW_FlowField_CopyPointsFieldType( SrcPointsFieldTypeData, DstPointsF ENDIF END SUBROUTINE IfW_FlowField_CopyPointsFieldType - SUBROUTINE IfW_FlowField_DestroyPointsFieldType( PointsFieldTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IfW_FlowField_DestroyPointsFieldType( PointsFieldTypeData, ErrStat, ErrMsg ) TYPE(PointsFieldType), INTENT(INOUT) :: PointsFieldTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyPointsFieldType' @@ -2619,12 +2577,6 @@ SUBROUTINE IfW_FlowField_DestroyPointsFieldType( PointsFieldTypeData, ErrStat, E ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(PointsFieldTypeData%Vel)) THEN DEALLOCATE(PointsFieldTypeData%Vel) ENDIF @@ -2789,14 +2741,12 @@ SUBROUTINE IfW_FlowField_CopyUserFieldType( SrcUserFieldTypeData, DstUserFieldTy DstUserFieldTypeData%RefHeight = SrcUserFieldTypeData%RefHeight END SUBROUTINE IfW_FlowField_CopyUserFieldType - SUBROUTINE IfW_FlowField_DestroyUserFieldType( UserFieldTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IfW_FlowField_DestroyUserFieldType( UserFieldTypeData, ErrStat, ErrMsg ) TYPE(UserFieldType), INTENT(INOUT) :: UserFieldTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyUserFieldType' @@ -2804,12 +2754,6 @@ SUBROUTINE IfW_FlowField_DestroyUserFieldType( UserFieldTypeData, ErrStat, ErrMs ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE IfW_FlowField_DestroyUserFieldType SUBROUTINE IfW_FlowField_PackUserFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2951,14 +2895,12 @@ SUBROUTINE IfW_FlowField_CopyFlowFieldType( SrcFlowFieldTypeData, DstFlowFieldTy IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE IfW_FlowField_CopyFlowFieldType - SUBROUTINE IfW_FlowField_DestroyFlowFieldType( FlowFieldTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE IfW_FlowField_DestroyFlowFieldType( FlowFieldTypeData, ErrStat, ErrMsg ) TYPE(FlowFieldType), INTENT(INOUT) :: FlowFieldTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyFlowFieldType' @@ -2966,21 +2908,15 @@ SUBROUTINE IfW_FlowField_DestroyFlowFieldType( FlowFieldTypeData, ErrStat, ErrMs ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL IfW_FlowField_Destroyuniformfieldtype( FlowFieldTypeData%Uniform, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IfW_FlowField_DestroyUniformFieldType( FlowFieldTypeData%Uniform, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IfW_FlowField_Destroygrid3dfieldtype( FlowFieldTypeData%Grid3D, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IfW_FlowField_DestroyGrid3DFieldType( FlowFieldTypeData%Grid3D, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IfW_FlowField_Destroygrid4dfieldtype( FlowFieldTypeData%Grid4D, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IfW_FlowField_DestroyGrid4DFieldType( FlowFieldTypeData%Grid4D, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IfW_FlowField_Destroypointsfieldtype( FlowFieldTypeData%Points, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IfW_FlowField_DestroyPointsFieldType( FlowFieldTypeData%Points, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IfW_FlowField_Destroyuserfieldtype( FlowFieldTypeData%User, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IfW_FlowField_DestroyUserFieldType( FlowFieldTypeData%User, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE IfW_FlowField_DestroyFlowFieldType @@ -3030,7 +2966,7 @@ SUBROUTINE IfW_FlowField_PackFlowFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Re_BufSz = Re_BufSz + SIZE(InData%RotFromWind) ! RotFromWind ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Uniform: size of buffers for each call to pack subtype - CALL IfW_FlowField_Packuniformfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%Uniform, ErrStat2, ErrMsg2, .TRUE. ) ! Uniform + CALL IfW_FlowField_PackUniformFieldType( Re_Buf, Db_Buf, Int_Buf, InData%Uniform, ErrStat2, ErrMsg2, .TRUE. ) ! Uniform CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3047,7 +2983,7 @@ SUBROUTINE IfW_FlowField_PackFlowFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Grid3D: size of buffers for each call to pack subtype - CALL IfW_FlowField_Packgrid3dfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%Grid3D, ErrStat2, ErrMsg2, .TRUE. ) ! Grid3D + CALL IfW_FlowField_PackGrid3DFieldType( Re_Buf, Db_Buf, Int_Buf, InData%Grid3D, ErrStat2, ErrMsg2, .TRUE. ) ! Grid3D CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3064,7 +3000,7 @@ SUBROUTINE IfW_FlowField_PackFlowFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Grid4D: size of buffers for each call to pack subtype - CALL IfW_FlowField_Packgrid4dfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%Grid4D, ErrStat2, ErrMsg2, .TRUE. ) ! Grid4D + CALL IfW_FlowField_PackGrid4DFieldType( Re_Buf, Db_Buf, Int_Buf, InData%Grid4D, ErrStat2, ErrMsg2, .TRUE. ) ! Grid4D CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3081,7 +3017,7 @@ SUBROUTINE IfW_FlowField_PackFlowFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Points: size of buffers for each call to pack subtype - CALL IfW_FlowField_Packpointsfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%Points, ErrStat2, ErrMsg2, .TRUE. ) ! Points + CALL IfW_FlowField_PackPointsFieldType( Re_Buf, Db_Buf, Int_Buf, InData%Points, ErrStat2, ErrMsg2, .TRUE. ) ! Points CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3098,7 +3034,7 @@ SUBROUTINE IfW_FlowField_PackFlowFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! User: size of buffers for each call to pack subtype - CALL IfW_FlowField_Packuserfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%User, ErrStat2, ErrMsg2, .TRUE. ) ! User + CALL IfW_FlowField_PackUserFieldType( Re_Buf, Db_Buf, Int_Buf, InData%User, ErrStat2, ErrMsg2, .TRUE. ) ! User CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3169,7 +3105,7 @@ SUBROUTINE IfW_FlowField_PackFlowFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Re_Xferred = Re_Xferred + 1 END DO END DO - CALL IfW_FlowField_Packuniformfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%Uniform, ErrStat2, ErrMsg2, OnlySize ) ! Uniform + CALL IfW_FlowField_PackUniformFieldType( Re_Buf, Db_Buf, Int_Buf, InData%Uniform, ErrStat2, ErrMsg2, OnlySize ) ! Uniform CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3197,7 +3133,7 @@ SUBROUTINE IfW_FlowField_PackFlowFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL IfW_FlowField_Packgrid3dfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%Grid3D, ErrStat2, ErrMsg2, OnlySize ) ! Grid3D + CALL IfW_FlowField_PackGrid3DFieldType( Re_Buf, Db_Buf, Int_Buf, InData%Grid3D, ErrStat2, ErrMsg2, OnlySize ) ! Grid3D CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3225,7 +3161,7 @@ SUBROUTINE IfW_FlowField_PackFlowFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL IfW_FlowField_Packgrid4dfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%Grid4D, ErrStat2, ErrMsg2, OnlySize ) ! Grid4D + CALL IfW_FlowField_PackGrid4DFieldType( Re_Buf, Db_Buf, Int_Buf, InData%Grid4D, ErrStat2, ErrMsg2, OnlySize ) ! Grid4D CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3253,7 +3189,7 @@ SUBROUTINE IfW_FlowField_PackFlowFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL IfW_FlowField_Packpointsfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%Points, ErrStat2, ErrMsg2, OnlySize ) ! Points + CALL IfW_FlowField_PackPointsFieldType( Re_Buf, Db_Buf, Int_Buf, InData%Points, ErrStat2, ErrMsg2, OnlySize ) ! Points CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3281,7 +3217,7 @@ SUBROUTINE IfW_FlowField_PackFlowFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL IfW_FlowField_Packuserfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%User, ErrStat2, ErrMsg2, OnlySize ) ! User + CALL IfW_FlowField_PackUserFieldType( Re_Buf, Db_Buf, Int_Buf, InData%User, ErrStat2, ErrMsg2, OnlySize ) ! User CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3410,7 +3346,7 @@ SUBROUTINE IfW_FlowField_UnPackFlowFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Outdat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IfW_FlowField_Unpackuniformfieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%Uniform, ErrStat2, ErrMsg2 ) ! Uniform + CALL IfW_FlowField_UnpackUniformFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%Uniform, ErrStat2, ErrMsg2 ) ! Uniform CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3450,7 +3386,7 @@ SUBROUTINE IfW_FlowField_UnPackFlowFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Outdat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IfW_FlowField_Unpackgrid3dfieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%Grid3D, ErrStat2, ErrMsg2 ) ! Grid3D + CALL IfW_FlowField_UnpackGrid3DFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%Grid3D, ErrStat2, ErrMsg2 ) ! Grid3D CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3490,7 +3426,7 @@ SUBROUTINE IfW_FlowField_UnPackFlowFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Outdat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IfW_FlowField_Unpackgrid4dfieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%Grid4D, ErrStat2, ErrMsg2 ) ! Grid4D + CALL IfW_FlowField_UnpackGrid4DFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%Grid4D, ErrStat2, ErrMsg2 ) ! Grid4D CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3530,7 +3466,7 @@ SUBROUTINE IfW_FlowField_UnPackFlowFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Outdat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IfW_FlowField_Unpackpointsfieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%Points, ErrStat2, ErrMsg2 ) ! Points + CALL IfW_FlowField_UnpackPointsFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%Points, ErrStat2, ErrMsg2 ) ! Points CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3570,7 +3506,7 @@ SUBROUTINE IfW_FlowField_UnPackFlowFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Outdat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IfW_FlowField_Unpackuserfieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%User, ErrStat2, ErrMsg2 ) ! User + CALL IfW_FlowField_UnpackUserFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%User, ErrStat2, ErrMsg2 ) ! User CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN diff --git a/modules/inflowwind/src/InflowWind.f90 b/modules/inflowwind/src/InflowWind.f90 index 46bf3325d9..299d949d12 100644 --- a/modules/inflowwind/src/InflowWind.f90 +++ b/modules/inflowwind/src/InflowWind.f90 @@ -809,7 +809,7 @@ SUBROUTINE InflowWind_End( InputData, p, ContStates, DiscStates, ConstrStateGues ! Destroy all inflow wind derived types CALL InflowWind_DestroyInput( InputData, ErrStat, ErrMsg ) - CALL InflowWind_DestroyParam( p, ErrStat, ErrMsg, DeallocatePointers=.true. ) + CALL InflowWind_DestroyParam( p, ErrStat, ErrMsg ) CALL InflowWind_DestroyContState( ContStates, ErrStat, ErrMsg ) CALL InflowWind_DestroyDiscState( DiscStates, ErrStat, ErrMsg ) CALL InflowWind_DestroyConstrState( ConstrStateGuess, ErrStat, ErrMsg ) diff --git a/modules/inflowwind/src/InflowWind_IO_Types.f90 b/modules/inflowwind/src/InflowWind_IO_Types.f90 index 4409b9804d..eb74581ab5 100644 --- a/modules/inflowwind/src/InflowWind_IO_Types.f90 +++ b/modules/inflowwind/src/InflowWind_IO_Types.f90 @@ -175,14 +175,12 @@ SUBROUTINE InflowWind_IO_CopyWindFileDat( SrcWindFileDatData, DstWindFileDatData DstWindFileDatData%MWS = SrcWindFileDatData%MWS END SUBROUTINE InflowWind_IO_CopyWindFileDat - SUBROUTINE InflowWind_IO_DestroyWindFileDat( WindFileDatData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_IO_DestroyWindFileDat( WindFileDatData, ErrStat, ErrMsg ) TYPE(WindFileDat), INTENT(INOUT) :: WindFileDatData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyWindFileDat' @@ -190,12 +188,6 @@ SUBROUTINE InflowWind_IO_DestroyWindFileDat( WindFileDatData, ErrStat, ErrMsg, D ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE InflowWind_IO_DestroyWindFileDat SUBROUTINE InflowWind_IO_PackWindFileDat( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -428,14 +420,12 @@ SUBROUTINE InflowWind_IO_CopySteady_InitInputType( SrcSteady_InitInputTypeData, DstSteady_InitInputTypeData%PLExp = SrcSteady_InitInputTypeData%PLExp END SUBROUTINE InflowWind_IO_CopySteady_InitInputType - SUBROUTINE InflowWind_IO_DestroySteady_InitInputType( Steady_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_IO_DestroySteady_InitInputType( Steady_InitInputTypeData, ErrStat, ErrMsg ) TYPE(Steady_InitInputType), INTENT(INOUT) :: Steady_InitInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroySteady_InitInputType' @@ -443,12 +433,6 @@ SUBROUTINE InflowWind_IO_DestroySteady_InitInputType( Steady_InitInputTypeData, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE InflowWind_IO_DestroySteady_InitInputType SUBROUTINE InflowWind_IO_PackSteady_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -582,14 +566,12 @@ SUBROUTINE InflowWind_IO_CopyUniform_InitInputType( SrcUniform_InitInputTypeData IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE InflowWind_IO_CopyUniform_InitInputType - SUBROUTINE InflowWind_IO_DestroyUniform_InitInputType( Uniform_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_IO_DestroyUniform_InitInputType( Uniform_InitInputTypeData, ErrStat, ErrMsg ) TYPE(Uniform_InitInputType), INTENT(INOUT) :: Uniform_InitInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyUniform_InitInputType' @@ -597,13 +579,7 @@ SUBROUTINE InflowWind_IO_DestroyUniform_InitInputType( Uniform_InitInputTypeData ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyfileinfotype( Uniform_InitInputTypeData%PassedFileData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyFileInfoType( Uniform_InitInputTypeData%PassedFileData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE InflowWind_IO_DestroyUniform_InitInputType @@ -649,7 +625,7 @@ SUBROUTINE InflowWind_IO_PackUniform_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Int_BufSz = Int_BufSz + 1 ! UseInputFile ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! PassedFileData: size of buffers for each call to pack subtype - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -704,7 +680,7 @@ SUBROUTINE InflowWind_IO_PackUniform_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Re_Xferred = Re_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -805,7 +781,7 @@ SUBROUTINE InflowWind_IO_UnPackUniform_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackfileinfotype( Re_Buf, Db_Buf, Int_Buf, OutData%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData + CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -843,14 +819,12 @@ SUBROUTINE InflowWind_IO_CopyGrid3D_InitInputType( SrcGrid3D_InitInputTypeData, DstGrid3D_InitInputTypeData%XOffset = SrcGrid3D_InitInputTypeData%XOffset END SUBROUTINE InflowWind_IO_CopyGrid3D_InitInputType - SUBROUTINE InflowWind_IO_DestroyGrid3D_InitInputType( Grid3D_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_IO_DestroyGrid3D_InitInputType( Grid3D_InitInputTypeData, ErrStat, ErrMsg ) TYPE(Grid3D_InitInputType), INTENT(INOUT) :: Grid3D_InitInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyGrid3D_InitInputType' @@ -858,12 +832,6 @@ SUBROUTINE InflowWind_IO_DestroyGrid3D_InitInputType( Grid3D_InitInputTypeData, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE InflowWind_IO_DestroyGrid3D_InitInputType SUBROUTINE InflowWind_IO_PackGrid3D_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1048,14 +1016,12 @@ SUBROUTINE InflowWind_IO_CopyTurbSim_InitInputType( SrcTurbSim_InitInputTypeData DstTurbSim_InitInputTypeData%WindFileName = SrcTurbSim_InitInputTypeData%WindFileName END SUBROUTINE InflowWind_IO_CopyTurbSim_InitInputType - SUBROUTINE InflowWind_IO_DestroyTurbSim_InitInputType( TurbSim_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_IO_DestroyTurbSim_InitInputType( TurbSim_InitInputTypeData, ErrStat, ErrMsg ) TYPE(TurbSim_InitInputType), INTENT(INOUT) :: TurbSim_InitInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyTurbSim_InitInputType' @@ -1063,12 +1029,6 @@ SUBROUTINE InflowWind_IO_DestroyTurbSim_InitInputType( TurbSim_InitInputTypeData ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE InflowWind_IO_DestroyTurbSim_InitInputType SUBROUTINE InflowWind_IO_PackTurbSim_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1194,14 +1154,12 @@ SUBROUTINE InflowWind_IO_CopyBladed_InitInputType( SrcBladed_InitInputTypeData, DstBladed_InitInputTypeData%FixedWindFileRootName = SrcBladed_InitInputTypeData%FixedWindFileRootName END SUBROUTINE InflowWind_IO_CopyBladed_InitInputType - SUBROUTINE InflowWind_IO_DestroyBladed_InitInputType( Bladed_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_IO_DestroyBladed_InitInputType( Bladed_InitInputTypeData, ErrStat, ErrMsg ) TYPE(Bladed_InitInputType), INTENT(INOUT) :: Bladed_InitInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyBladed_InitInputType' @@ -1209,12 +1167,6 @@ SUBROUTINE InflowWind_IO_DestroyBladed_InitInputType( Bladed_InitInputTypeData, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE InflowWind_IO_DestroyBladed_InitInputType SUBROUTINE InflowWind_IO_PackBladed_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1361,14 +1313,12 @@ SUBROUTINE InflowWind_IO_CopyBladed_InitOutputType( SrcBladed_InitOutputTypeData DstBladed_InitOutputTypeData%VFlowAngle = SrcBladed_InitOutputTypeData%VFlowAngle END SUBROUTINE InflowWind_IO_CopyBladed_InitOutputType - SUBROUTINE InflowWind_IO_DestroyBladed_InitOutputType( Bladed_InitOutputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_IO_DestroyBladed_InitOutputType( Bladed_InitOutputTypeData, ErrStat, ErrMsg ) TYPE(Bladed_InitOutputType), INTENT(INOUT) :: Bladed_InitOutputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyBladed_InitOutputType' @@ -1376,12 +1326,6 @@ SUBROUTINE InflowWind_IO_DestroyBladed_InitOutputType( Bladed_InitOutputTypeData ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE InflowWind_IO_DestroyBladed_InitOutputType SUBROUTINE InflowWind_IO_PackBladed_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1513,14 +1457,12 @@ SUBROUTINE InflowWind_IO_CopyHAWC_InitInputType( SrcHAWC_InitInputTypeData, DstH IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE InflowWind_IO_CopyHAWC_InitInputType - SUBROUTINE InflowWind_IO_DestroyHAWC_InitInputType( HAWC_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_IO_DestroyHAWC_InitInputType( HAWC_InitInputTypeData, ErrStat, ErrMsg ) TYPE(HAWC_InitInputType), INTENT(INOUT) :: HAWC_InitInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyHAWC_InitInputType' @@ -1528,13 +1470,7 @@ SUBROUTINE InflowWind_IO_DestroyHAWC_InitInputType( HAWC_InitInputTypeData, ErrS ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL InflowWind_IO_Destroygrid3d_initinputtype( HAWC_InitInputTypeData%G3D, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_IO_DestroyGrid3D_InitInputType( HAWC_InitInputTypeData%G3D, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE InflowWind_IO_DestroyHAWC_InitInputType @@ -1582,7 +1518,7 @@ SUBROUTINE InflowWind_IO_PackHAWC_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Ind Re_BufSz = Re_BufSz + 1 ! dz ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! G3D: size of buffers for each call to pack subtype - CALL InflowWind_IO_Packgrid3d_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%G3D, ErrStat2, ErrMsg2, .TRUE. ) ! G3D + CALL InflowWind_IO_PackGrid3D_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%G3D, ErrStat2, ErrMsg2, .TRUE. ) ! G3D CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1643,7 +1579,7 @@ SUBROUTINE InflowWind_IO_PackHAWC_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Ind Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%dz Re_Xferred = Re_Xferred + 1 - CALL InflowWind_IO_Packgrid3d_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%G3D, ErrStat2, ErrMsg2, OnlySize ) ! G3D + CALL InflowWind_IO_PackGrid3D_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%G3D, ErrStat2, ErrMsg2, OnlySize ) ! G3D CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1753,7 +1689,7 @@ SUBROUTINE InflowWind_IO_UnPackHAWC_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, O Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL InflowWind_IO_Unpackgrid3d_initinputtype( Re_Buf, Db_Buf, Int_Buf, OutData%G3D, ErrStat2, ErrMsg2 ) ! G3D + CALL InflowWind_IO_UnpackGrid3D_InitInputType( Re_Buf, Db_Buf, Int_Buf, OutData%G3D, ErrStat2, ErrMsg2 ) ! G3D CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1779,14 +1715,12 @@ SUBROUTINE InflowWind_IO_CopyUser_InitInputType( SrcUser_InitInputTypeData, DstU DstUser_InitInputTypeData%Dummy = SrcUser_InitInputTypeData%Dummy END SUBROUTINE InflowWind_IO_CopyUser_InitInputType - SUBROUTINE InflowWind_IO_DestroyUser_InitInputType( User_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_IO_DestroyUser_InitInputType( User_InitInputTypeData, ErrStat, ErrMsg ) TYPE(User_InitInputType), INTENT(INOUT) :: User_InitInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyUser_InitInputType' @@ -1794,12 +1728,6 @@ SUBROUTINE InflowWind_IO_DestroyUser_InitInputType( User_InitInputTypeData, ErrS ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE InflowWind_IO_DestroyUser_InitInputType SUBROUTINE InflowWind_IO_PackUser_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1919,14 +1847,12 @@ SUBROUTINE InflowWind_IO_CopyGrid4D_InitInputType( SrcGrid4D_InitInputTypeData, DstGrid4D_InitInputTypeData%pZero = SrcGrid4D_InitInputTypeData%pZero END SUBROUTINE InflowWind_IO_CopyGrid4D_InitInputType - SUBROUTINE InflowWind_IO_DestroyGrid4D_InitInputType( Grid4D_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_IO_DestroyGrid4D_InitInputType( Grid4D_InitInputTypeData, ErrStat, ErrMsg ) TYPE(Grid4D_InitInputType), INTENT(INOUT) :: Grid4D_InitInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyGrid4D_InitInputType' @@ -1934,12 +1860,6 @@ SUBROUTINE InflowWind_IO_DestroyGrid4D_InitInputType( Grid4D_InitInputTypeData, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE InflowWind_IO_DestroyGrid4D_InitInputType SUBROUTINE InflowWind_IO_PackGrid4D_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2085,14 +2005,12 @@ SUBROUTINE InflowWind_IO_CopyPoints_InitInputType( SrcPoints_InitInputTypeData, DstPoints_InitInputTypeData%NumWindPoints = SrcPoints_InitInputTypeData%NumWindPoints END SUBROUTINE InflowWind_IO_CopyPoints_InitInputType - SUBROUTINE InflowWind_IO_DestroyPoints_InitInputType( Points_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_IO_DestroyPoints_InitInputType( Points_InitInputTypeData, ErrStat, ErrMsg ) TYPE(Points_InitInputType), INTENT(INOUT) :: Points_InitInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyPoints_InitInputType' @@ -2100,12 +2018,6 @@ SUBROUTINE InflowWind_IO_DestroyPoints_InitInputType( Points_InitInputTypeData, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE InflowWind_IO_DestroyPoints_InitInputType SUBROUTINE InflowWind_IO_PackPoints_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index 605bfe2228..10a8cf73fc 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -31,6 +31,7 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE InflowWind_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE IfW_FlowField_Types USE InflowWind_IO_Types USE Lidar_Types USE NWTC_Library @@ -210,7 +211,6 @@ SUBROUTINE InflowWind_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCod ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_CopyInputFile' @@ -344,14 +344,12 @@ SUBROUTINE InflowWind_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCod IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE InflowWind_CopyInputFile - SUBROUTINE InflowWind_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) TYPE(InflowWind_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyInputFile' @@ -359,12 +357,6 @@ SUBROUTINE InflowWind_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputFileData%WindVxiList)) THEN DEALLOCATE(InputFileData%WindVxiList) ENDIF @@ -386,7 +378,7 @@ SUBROUTINE InflowWind_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCA IF (ALLOCATED(InputFileData%FocalDistanceZ)) THEN DEALLOCATE(InputFileData%FocalDistanceZ) ENDIF - CALL InflowWind_IO_Destroygrid3d_initinputtype( InputFileData%FF, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_IO_DestroyGrid3D_InitInputType( InputFileData%FF, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE InflowWind_DestroyInputFile @@ -500,7 +492,7 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Int_BufSz = Int_BufSz + 1 ! ConsiderHubMotion ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! FF: size of buffers for each call to pack subtype - CALL InflowWind_IO_Packgrid3d_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%FF, ErrStat2, ErrMsg2, .TRUE. ) ! FF + CALL InflowWind_IO_PackGrid3D_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%FF, ErrStat2, ErrMsg2, .TRUE. ) ! FF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -744,7 +736,7 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%ConsiderHubMotion Int_Xferred = Int_Xferred + 1 - CALL InflowWind_IO_Packgrid3d_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%FF, ErrStat2, ErrMsg2, OnlySize ) ! FF + CALL InflowWind_IO_PackGrid3D_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%FF, ErrStat2, ErrMsg2, OnlySize ) ! FF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -788,7 +780,6 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackInputFile' @@ -1059,7 +1050,7 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL InflowWind_IO_Unpackgrid3d_initinputtype( Re_Buf, Db_Buf, Int_Buf, OutData%FF, ErrStat2, ErrMsg2 ) ! FF + CALL InflowWind_IO_UnpackGrid3D_InitInputType( Re_Buf, Db_Buf, Int_Buf, OutData%FF, ErrStat2, ErrMsg2 ) ! FF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1112,14 +1103,12 @@ SUBROUTINE InflowWind_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCod DstInitInputData%BoxExceedAllowF = SrcInitInputData%BoxExceedAllowF END SUBROUTINE InflowWind_CopyInitInput - SUBROUTINE InflowWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(InflowWind_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyInitInput' @@ -1127,19 +1116,13 @@ SUBROUTINE InflowWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedFileData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedFileData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroyfileinfotype( InitInputData%WindType2Data, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyFileInfoType( InitInputData%WindType2Data, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Lidar_DestroyInitInput( InitInputData%lidar, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Lidar_DestroyInitInput( InitInputData%lidar, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_IO_Destroygrid4d_initinputtype( InitInputData%FDext, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_IO_DestroyGrid4D_InitInputType( InitInputData%FDext, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE InflowWind_DestroyInitInput @@ -1188,7 +1171,7 @@ SUBROUTINE InflowWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! PassedFileData: size of buffers for each call to pack subtype - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1206,7 +1189,7 @@ SUBROUTINE InflowWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat END IF Int_BufSz = Int_BufSz + 1 ! WindType2UseInputFile Int_BufSz = Int_BufSz + 3 ! WindType2Data: size of buffers for each call to pack subtype - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%WindType2Data, ErrStat2, ErrMsg2, .TRUE. ) ! WindType2Data + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%WindType2Data, ErrStat2, ErrMsg2, .TRUE. ) ! WindType2Data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1241,7 +1224,7 @@ SUBROUTINE InflowWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! FDext: size of buffers for each call to pack subtype - CALL InflowWind_IO_Packgrid4d_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%FDext, ErrStat2, ErrMsg2, .TRUE. ) ! FDext + CALL InflowWind_IO_PackGrid4D_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%FDext, ErrStat2, ErrMsg2, .TRUE. ) ! FDext CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1310,7 +1293,7 @@ SUBROUTINE InflowWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) Int_Xferred = Int_Xferred + 1 END DO ! I - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1340,7 +1323,7 @@ SUBROUTINE InflowWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ENDIF IntKiBuf(Int_Xferred) = TRANSFER(InData%WindType2UseInputFile, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%WindType2Data, ErrStat2, ErrMsg2, OnlySize ) ! WindType2Data + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%WindType2Data, ErrStat2, ErrMsg2, OnlySize ) ! WindType2Data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1398,7 +1381,7 @@ SUBROUTINE InflowWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL InflowWind_IO_Packgrid4d_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%FDext, ErrStat2, ErrMsg2, OnlySize ) ! FDext + CALL InflowWind_IO_PackGrid4D_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%FDext, ErrStat2, ErrMsg2, OnlySize ) ! FDext CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1519,7 +1502,7 @@ SUBROUTINE InflowWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackfileinfotype( Re_Buf, Db_Buf, Int_Buf, OutData%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData + CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1561,7 +1544,7 @@ SUBROUTINE InflowWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackfileinfotype( Re_Buf, Db_Buf, Int_Buf, OutData%WindType2Data, ErrStat2, ErrMsg2 ) ! WindType2Data + CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%WindType2Data, ErrStat2, ErrMsg2 ) ! WindType2Data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1643,7 +1626,7 @@ SUBROUTINE InflowWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL InflowWind_IO_Unpackgrid4d_initinputtype( Re_Buf, Db_Buf, Int_Buf, OutData%FDext, ErrStat2, ErrMsg2 ) ! FDext + CALL InflowWind_IO_UnpackGrid4D_InitInputType( Re_Buf, Db_Buf, Int_Buf, OutData%FDext, ErrStat2, ErrMsg2 ) ! FDext CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1771,14 +1754,12 @@ SUBROUTINE InflowWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, Ctrl ENDIF END SUBROUTINE InflowWind_CopyInitOutput - SUBROUTINE InflowWind_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(InflowWind_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyInitOutput' @@ -1786,21 +1767,15 @@ SUBROUTINE InflowWind_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) ENDIF IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN DEALLOCATE(InitOutputData%WriteOutputUnt) ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_IO_Destroywindfiledat( InitOutputData%WindFileInfo, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_IO_DestroyWindFileDat( InitOutputData%WindFileInfo, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitOutputData%LinNames_y)) THEN DEALLOCATE(InitOutputData%LinNames_y) @@ -1866,7 +1841,7 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1883,7 +1858,7 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! WindFileInfo: size of buffers for each call to pack subtype - CALL InflowWind_IO_Packwindfiledat( Re_Buf, Db_Buf, Int_Buf, InData%WindFileInfo, ErrStat2, ErrMsg2, .TRUE. ) ! WindFileInfo + CALL InflowWind_IO_PackWindFileDat( Re_Buf, Db_Buf, Int_Buf, InData%WindFileInfo, ErrStat2, ErrMsg2, .TRUE. ) ! WindFileInfo CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1985,7 +1960,7 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta END DO ! I END DO END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2013,7 +1988,7 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL InflowWind_IO_Packwindfiledat( Re_Buf, Db_Buf, Int_Buf, InData%WindFileInfo, ErrStat2, ErrMsg2, OnlySize ) ! WindFileInfo + CALL InflowWind_IO_PackWindFileDat( Re_Buf, Db_Buf, Int_Buf, InData%WindFileInfo, ErrStat2, ErrMsg2, OnlySize ) ! WindFileInfo CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2222,7 +2197,7 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2262,7 +2237,7 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL InflowWind_IO_Unpackwindfiledat( Re_Buf, Db_Buf, Int_Buf, OutData%WindFileInfo, ErrStat2, ErrMsg2 ) ! WindFileInfo + CALL InflowWind_IO_UnpackWindFileDat( Re_Buf, Db_Buf, Int_Buf, OutData%WindFileInfo, ErrStat2, ErrMsg2 ) ! WindFileInfo CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2467,14 +2442,12 @@ SUBROUTINE InflowWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, DstParamData%OutputAccel = SrcParamData%OutputAccel END SUBROUTINE InflowWind_CopyParam - SUBROUTINE InflowWind_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(InflowWind_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyParam' @@ -2482,26 +2455,20 @@ SUBROUTINE InflowWind_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%WindViXYZprime)) THEN DEALLOCATE(ParamData%WindViXYZprime) ENDIF IF (ALLOCATED(ParamData%WindViXYZ)) THEN DEALLOCATE(ParamData%WindViXYZ) ENDIF - CALL IfW_FlowField_Destroyflowfieldtype( ParamData%FlowField, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IfW_FlowField_DestroyFlowFieldType( ParamData%FlowField, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(ParamData%PositionAvg)) THEN DEALLOCATE(ParamData%PositionAvg) ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) @@ -2509,7 +2476,7 @@ SUBROUTINE InflowWind_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointe IF (ALLOCATED(ParamData%OutParamLinIndx)) THEN DEALLOCATE(ParamData%OutParamLinIndx) ENDIF - CALL Lidar_DestroyParam( ParamData%lidar, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Lidar_DestroyParam( ParamData%lidar, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE InflowWind_DestroyParam @@ -2563,7 +2530,7 @@ SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! FlowField: size of buffers for each call to pack subtype - CALL IfW_FlowField_Packflowfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%FlowField, ErrStat2, ErrMsg2, .TRUE. ) ! FlowField + CALL IfW_FlowField_PackFlowFieldType( Re_Buf, Db_Buf, Int_Buf, InData%FlowField, ErrStat2, ErrMsg2, .TRUE. ) ! FlowField CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2591,7 +2558,7 @@ SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2707,7 +2674,7 @@ SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END DO END DO END IF - CALL IfW_FlowField_Packflowfieldtype( Re_Buf, Db_Buf, Int_Buf, InData%FlowField, ErrStat2, ErrMsg2, OnlySize ) ! FlowField + CALL IfW_FlowField_PackFlowFieldType( Re_Buf, Db_Buf, Int_Buf, InData%FlowField, ErrStat2, ErrMsg2, OnlySize ) ! FlowField CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2770,7 +2737,7 @@ SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2967,7 +2934,7 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IfW_FlowField_Unpackflowfieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%FlowField, ErrStat2, ErrMsg2 ) ! FlowField + CALL IfW_FlowField_UnpackFlowFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%FlowField, ErrStat2, ErrMsg2 ) ! FlowField CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3048,7 +3015,7 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3161,14 +3128,12 @@ SUBROUTINE InflowWind_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, DstInputData%HubOrientation = SrcInputData%HubOrientation END SUBROUTINE InflowWind_CopyInput - SUBROUTINE InflowWind_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(InflowWind_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyInput' @@ -3176,16 +3141,10 @@ SUBROUTINE InflowWind_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputData%PositionXYZ)) THEN DEALLOCATE(InputData%PositionXYZ) ENDIF - CALL Lidar_DestroyInput( InputData%lidar, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Lidar_DestroyInput( InputData%lidar, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE InflowWind_DestroyInput @@ -3508,14 +3467,12 @@ SUBROUTINE InflowWind_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrSta IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE InflowWind_CopyOutput - SUBROUTINE InflowWind_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(InflowWind_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyOutput' @@ -3523,12 +3480,6 @@ SUBROUTINE InflowWind_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%VelocityUVW)) THEN DEALLOCATE(OutputData%VelocityUVW) ENDIF @@ -3538,7 +3489,7 @@ SUBROUTINE InflowWind_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpoin IF (ALLOCATED(OutputData%WriteOutput)) THEN DEALLOCATE(OutputData%WriteOutput) ENDIF - CALL Lidar_DestroyOutput( OutputData%lidar, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Lidar_DestroyOutput( OutputData%lidar, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE InflowWind_DestroyOutput @@ -3895,14 +3846,12 @@ SUBROUTINE InflowWind_CopyContState( SrcContStateData, DstContStateData, CtrlCod DstContStateData%DummyContState = SrcContStateData%DummyContState END SUBROUTINE InflowWind_CopyContState - SUBROUTINE InflowWind_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(InflowWind_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyContState' @@ -3910,12 +3859,6 @@ SUBROUTINE InflowWind_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE InflowWind_DestroyContState SUBROUTINE InflowWind_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -4032,14 +3975,12 @@ SUBROUTINE InflowWind_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCod DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE InflowWind_CopyDiscState - SUBROUTINE InflowWind_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(InflowWind_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyDiscState' @@ -4047,12 +3988,6 @@ SUBROUTINE InflowWind_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE InflowWind_DestroyDiscState SUBROUTINE InflowWind_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -4169,14 +4104,12 @@ SUBROUTINE InflowWind_CopyConstrState( SrcConstrStateData, DstConstrStateData, C DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE InflowWind_CopyConstrState - SUBROUTINE InflowWind_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(InflowWind_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyConstrState' @@ -4184,12 +4117,6 @@ SUBROUTINE InflowWind_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEAL ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE InflowWind_DestroyConstrState SUBROUTINE InflowWind_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -4306,14 +4233,12 @@ SUBROUTINE InflowWind_CopyOtherState( SrcOtherStateData, DstOtherStateData, Ctrl DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState END SUBROUTINE InflowWind_CopyOtherState - SUBROUTINE InflowWind_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(InflowWind_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyOtherState' @@ -4321,12 +4246,6 @@ SUBROUTINE InflowWind_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE InflowWind_DestroyOtherState SUBROUTINE InflowWind_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -4496,14 +4415,12 @@ SUBROUTINE InflowWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, Err IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE InflowWind_CopyMisc - SUBROUTINE InflowWind_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE InflowWind_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(InflowWind_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyMisc' @@ -4511,12 +4428,6 @@ SUBROUTINE InflowWind_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MiscData%AllOuts)) THEN DEALLOCATE(MiscData%AllOuts) ENDIF @@ -4526,13 +4437,13 @@ SUBROUTINE InflowWind_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers IF (ALLOCATED(MiscData%WindAiUVW)) THEN DEALLOCATE(MiscData%WindAiUVW) ENDIF - CALL InflowWind_DestroyInput( MiscData%u_Avg, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyInput( MiscData%u_Avg, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( MiscData%y_Avg, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyOutput( MiscData%y_Avg, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( MiscData%u_Hub, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyInput( MiscData%u_Hub, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( MiscData%y_Hub, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyOutput( MiscData%y_Hub, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE InflowWind_DestroyMisc diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index f95da86717..7b23f352c0 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -33,10 +33,10 @@ MODULE Lidar_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_None = 0 - INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_SinglePoint = 1 - INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_ContinuousLidar = 2 - INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_PulsedLidar = 3 + INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_None = 0 + INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_SinglePoint = 1 + INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_ContinuousLidar = 2 + INTEGER(IntKi), PUBLIC, PARAMETER :: SensorType_PulsedLidar = 3 ! ========= Lidar_InitInputType ======= TYPE, PUBLIC :: Lidar_InitInputType INTEGER(IntKi) :: SensorType = SensorType_None !< SensorType_* parameter [-] @@ -133,7 +133,6 @@ SUBROUTINE Lidar_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_CopyInitInput' @@ -148,14 +147,12 @@ SUBROUTINE Lidar_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%LidRadialVel = SrcInitInputData%LidRadialVel END SUBROUTINE Lidar_CopyInitInput - SUBROUTINE Lidar_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Lidar_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(Lidar_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyInitInput' @@ -163,12 +160,6 @@ SUBROUTINE Lidar_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Lidar_DestroyInitInput SUBROUTINE Lidar_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -271,7 +262,6 @@ SUBROUTINE Lidar_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackInitInput' @@ -324,14 +314,12 @@ SUBROUTINE Lidar_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%DummyInitOut = SrcInitOutputData%DummyInitOut END SUBROUTINE Lidar_CopyInitOutput - SUBROUTINE Lidar_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Lidar_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(Lidar_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyInitOutput' @@ -339,12 +327,6 @@ SUBROUTINE Lidar_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Lidar_DestroyInitOutput SUBROUTINE Lidar_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -532,14 +514,12 @@ SUBROUTINE Lidar_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%LidPosition = SrcParamData%LidPosition END SUBROUTINE Lidar_CopyParam - SUBROUTINE Lidar_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Lidar_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(Lidar_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyParam' @@ -547,12 +527,6 @@ SUBROUTINE Lidar_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%FocalDistanceX)) THEN DEALLOCATE(ParamData%FocalDistanceX) ENDIF @@ -952,14 +926,12 @@ SUBROUTINE Lidar_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Er DstContStateData%DummyContState = SrcContStateData%DummyContState END SUBROUTINE Lidar_CopyContState - SUBROUTINE Lidar_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Lidar_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(Lidar_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyContState' @@ -967,12 +939,6 @@ SUBROUTINE Lidar_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Lidar_DestroyContState SUBROUTINE Lidar_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1089,14 +1055,12 @@ SUBROUTINE Lidar_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Er DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE Lidar_CopyDiscState - SUBROUTINE Lidar_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Lidar_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(Lidar_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyDiscState' @@ -1104,12 +1068,6 @@ SUBROUTINE Lidar_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Lidar_DestroyDiscState SUBROUTINE Lidar_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1226,14 +1184,12 @@ SUBROUTINE Lidar_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCo DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE Lidar_CopyConstrState - SUBROUTINE Lidar_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Lidar_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(Lidar_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyConstrState' @@ -1241,12 +1197,6 @@ SUBROUTINE Lidar_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCAT ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Lidar_DestroyConstrState SUBROUTINE Lidar_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1363,14 +1313,12 @@ SUBROUTINE Lidar_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState END SUBROUTINE Lidar_CopyOtherState - SUBROUTINE Lidar_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Lidar_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(Lidar_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyOtherState' @@ -1378,12 +1326,6 @@ SUBROUTINE Lidar_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Lidar_DestroyOtherState SUBROUTINE Lidar_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1500,14 +1442,12 @@ SUBROUTINE Lidar_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar END SUBROUTINE Lidar_CopyMisc - SUBROUTINE Lidar_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Lidar_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(Lidar_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyMisc' @@ -1515,12 +1455,6 @@ SUBROUTINE Lidar_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Lidar_DestroyMisc SUBROUTINE Lidar_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1641,14 +1575,12 @@ SUBROUTINE Lidar_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs DstInputData%HubDisplacementZ = SrcInputData%HubDisplacementZ END SUBROUTINE Lidar_CopyInput - SUBROUTINE Lidar_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Lidar_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(Lidar_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyInput' @@ -1656,12 +1588,6 @@ SUBROUTINE Lidar_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Lidar_DestroyInput SUBROUTINE Lidar_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1858,14 +1784,12 @@ SUBROUTINE Lidar_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er ENDIF END SUBROUTINE Lidar_CopyOutput - SUBROUTINE Lidar_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Lidar_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(Lidar_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyOutput' @@ -1873,12 +1797,6 @@ SUBROUTINE Lidar_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%LidSpeed)) THEN DEALLOCATE(OutputData%LidSpeed) ENDIF diff --git a/modules/map/src/MAP_Fortran_Types.f90 b/modules/map/src/MAP_Fortran_Types.f90 index 4bed537cd2..f8acf9447f 100644 --- a/modules/map/src/MAP_Fortran_Types.f90 +++ b/modules/map/src/MAP_Fortran_Types.f90 @@ -61,8 +61,6 @@ SUBROUTINE MAP_Fortran_CopyLin_InitInputType( SrcLin_InitInputTypeData, DstLin_I CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_CopyLin_InitInputType' @@ -72,14 +70,12 @@ SUBROUTINE MAP_Fortran_CopyLin_InitInputType( SrcLin_InitInputTypeData, DstLin_I DstLin_InitInputTypeData%linearize = SrcLin_InitInputTypeData%linearize END SUBROUTINE MAP_Fortran_CopyLin_InitInputType - SUBROUTINE MAP_Fortran_DestroyLin_InitInputType( Lin_InitInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MAP_Fortran_DestroyLin_InitInputType( Lin_InitInputTypeData, ErrStat, ErrMsg ) TYPE(Lin_InitInputType), INTENT(INOUT) :: Lin_InitInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_DestroyLin_InitInputType' @@ -87,12 +83,6 @@ SUBROUTINE MAP_Fortran_DestroyLin_InitInputType( Lin_InitInputTypeData, ErrStat, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE MAP_Fortran_DestroyLin_InitInputType SUBROUTINE MAP_Fortran_PackLin_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -175,8 +165,6 @@ SUBROUTINE MAP_Fortran_UnPackLin_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outd INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_UnPackLin_InitInputType' @@ -247,14 +235,12 @@ SUBROUTINE MAP_Fortran_CopyLin_InitOutputType( SrcLin_InitOutputTypeData, DstLin ENDIF END SUBROUTINE MAP_Fortran_CopyLin_InitOutputType - SUBROUTINE MAP_Fortran_DestroyLin_InitOutputType( Lin_InitOutputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MAP_Fortran_DestroyLin_InitOutputType( Lin_InitOutputTypeData, ErrStat, ErrMsg ) TYPE(Lin_InitOutputType), INTENT(INOUT) :: Lin_InitOutputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_DestroyLin_InitOutputType' @@ -262,12 +248,6 @@ SUBROUTINE MAP_Fortran_DestroyLin_InitOutputType( Lin_InitOutputTypeData, ErrSta ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(Lin_InitOutputTypeData%LinNames_y)) THEN DEALLOCATE(Lin_InitOutputTypeData%LinNames_y) ENDIF @@ -528,14 +508,12 @@ SUBROUTINE MAP_Fortran_CopyLin_ParamType( SrcLin_ParamTypeData, DstLin_ParamType DstLin_ParamTypeData%Jac_ny = SrcLin_ParamTypeData%Jac_ny END SUBROUTINE MAP_Fortran_CopyLin_ParamType - SUBROUTINE MAP_Fortran_DestroyLin_ParamType( Lin_ParamTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MAP_Fortran_DestroyLin_ParamType( Lin_ParamTypeData, ErrStat, ErrMsg ) TYPE(Lin_ParamType), INTENT(INOUT) :: Lin_ParamTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_DestroyLin_ParamType' @@ -543,12 +521,6 @@ SUBROUTINE MAP_Fortran_DestroyLin_ParamType( Lin_ParamTypeData, ErrStat, ErrMsg, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(Lin_ParamTypeData%Jac_u_indx)) THEN DEALLOCATE(Lin_ParamTypeData%Jac_u_indx) ENDIF diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index d179fa96e9..1e63666bd6 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -32,7 +32,6 @@ MODULE MAP_Types !--------------------------------------------------------------------------------------------------------------------------------- USE MAP_Fortran_Types -!USE, INTRINSIC :: ISO_C_Binding USE NWTC_Library IMPLICIT NONE ! ========= MAP_InitInputType_C ======= @@ -255,7 +254,6 @@ SUBROUTINE MAP_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrS CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_CopyInitInput' @@ -285,14 +283,12 @@ SUBROUTINE MAP_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrS IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE MAP_CopyInitInput - SUBROUTINE MAP_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MAP_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyInitInput' @@ -300,13 +296,7 @@ SUBROUTINE MAP_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MAP_Fortran_Destroylin_initinputtype( InitInputData%LinInitInp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_Fortran_DestroyLin_InitInputType( InitInputData%LinInitInp, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE MAP_DestroyInitInput @@ -356,7 +346,7 @@ SUBROUTINE MAP_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 1*LEN(InData%option_input_str) ! option_input_str ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! LinInitInp: size of buffers for each call to pack subtype - CALL MAP_Fortran_Packlin_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%LinInitInp, ErrStat2, ErrMsg2, .TRUE. ) ! LinInitInp + CALL MAP_Fortran_PackLin_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%LinInitInp, ErrStat2, ErrMsg2, .TRUE. ) ! LinInitInp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -431,7 +421,7 @@ SUBROUTINE MAP_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf(Int_Xferred) = ICHAR(InData%option_input_str(I:I), IntKi) Int_Xferred = Int_Xferred + 1 END DO ! I - CALL MAP_Fortran_Packlin_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%LinInitInp, ErrStat2, ErrMsg2, OnlySize ) ! LinInitInp + CALL MAP_Fortran_PackLin_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%LinInitInp, ErrStat2, ErrMsg2, OnlySize ) ! LinInitInp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -474,7 +464,6 @@ SUBROUTINE MAP_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_UnPackInitInput' @@ -560,7 +549,7 @@ SUBROUTINE MAP_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_Fortran_Unpacklin_initinputtype( Re_Buf, Db_Buf, Int_Buf, OutData%LinInitInp, ErrStat2, ErrMsg2 ) ! LinInitInp + CALL MAP_Fortran_UnpackLin_InitInputType( Re_Buf, Db_Buf, Int_Buf, OutData%LinInitInp, ErrStat2, ErrMsg2 ) ! LinInitInp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -674,14 +663,12 @@ SUBROUTINE MAP_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, E IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE MAP_CopyInitOutput - SUBROUTINE MAP_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MAP_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(MAP_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyInitOutput' @@ -689,21 +676,15 @@ SUBROUTINE MAP_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%writeOutputHdr)) THEN DEALLOCATE(InitOutputData%writeOutputHdr) ENDIF IF (ALLOCATED(InitOutputData%writeOutputUnt)) THEN DEALLOCATE(InitOutputData%writeOutputUnt) ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_Fortran_Destroylin_initoutputtype( InitOutputData%LinInitOut, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_Fortran_DestroyLin_InitOutputType( InitOutputData%LinInitOut, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE MAP_DestroyInitOutput @@ -757,7 +738,7 @@ SUBROUTINE MAP_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -774,7 +755,7 @@ SUBROUTINE MAP_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! LinInitOut: size of buffers for each call to pack subtype - CALL MAP_Fortran_Packlin_initoutputtype( Re_Buf, Db_Buf, Int_Buf, InData%LinInitOut, ErrStat2, ErrMsg2, .TRUE. ) ! LinInitOut + CALL MAP_Fortran_PackLin_InitOutputType( Re_Buf, Db_Buf, Int_Buf, InData%LinInitOut, ErrStat2, ErrMsg2, .TRUE. ) ! LinInitOut CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -865,7 +846,7 @@ SUBROUTINE MAP_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM END DO ! I END DO END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -893,7 +874,7 @@ SUBROUTINE MAP_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MAP_Fortran_Packlin_initoutputtype( Re_Buf, Db_Buf, Int_Buf, InData%LinInitOut, ErrStat2, ErrMsg2, OnlySize ) ! LinInitOut + CALL MAP_Fortran_PackLin_InitOutputType( Re_Buf, Db_Buf, Int_Buf, InData%LinInitOut, ErrStat2, ErrMsg2, OnlySize ) ! LinInitOut CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1038,7 +1019,7 @@ SUBROUTINE MAP_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1078,7 +1059,7 @@ SUBROUTINE MAP_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_Fortran_Unpacklin_initoutputtype( Re_Buf, Db_Buf, Int_Buf, OutData%LinInitOut, ErrStat2, ErrMsg2 ) ! LinInitOut + CALL MAP_Fortran_UnpackLin_InitOutputType( Re_Buf, Db_Buf, Int_Buf, OutData%LinInitOut, ErrStat2, ErrMsg2 ) ! LinInitOut CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1145,14 +1126,12 @@ SUBROUTINE MAP_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrS DstContStateData%C_obj%dummy = SrcContStateData%C_obj%dummy END SUBROUTINE MAP_CopyContState - SUBROUTINE MAP_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MAP_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyContState' @@ -1160,12 +1139,6 @@ SUBROUTINE MAP_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE MAP_DestroyContState SUBROUTINE MAP_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1322,14 +1295,12 @@ SUBROUTINE MAP_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS DstDiscStateData%C_obj%dummy = SrcDiscStateData%C_obj%dummy END SUBROUTINE MAP_CopyDiscState - SUBROUTINE MAP_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MAP_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyDiscState' @@ -1337,12 +1308,6 @@ SUBROUTINE MAP_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE MAP_DestroyDiscState SUBROUTINE MAP_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1505,9 +1470,9 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%H.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOtherStateData%c_obj%H_Len = SIZE(DstOtherStateData%H) - IF (DstOtherStateData%c_obj%H_Len > 0) & - DstOtherStateData%c_obj%H = C_LOC( DstOtherStateData%H( i1_l ) ) + DstOtherStateData%C_obj%H_Len = SIZE(DstOtherStateData%H) + IF (DstOtherStateData%C_obj%H_Len > 0) & + DstOtherStateData%C_obj%H = C_LOC( DstOtherStateData%H( i1_l ) ) END IF DstOtherStateData%H = SrcOtherStateData%H ENDIF @@ -1520,9 +1485,9 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%V.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOtherStateData%c_obj%V_Len = SIZE(DstOtherStateData%V) - IF (DstOtherStateData%c_obj%V_Len > 0) & - DstOtherStateData%c_obj%V = C_LOC( DstOtherStateData%V( i1_l ) ) + DstOtherStateData%C_obj%V_Len = SIZE(DstOtherStateData%V) + IF (DstOtherStateData%C_obj%V_Len > 0) & + DstOtherStateData%C_obj%V = C_LOC( DstOtherStateData%V( i1_l ) ) END IF DstOtherStateData%V = SrcOtherStateData%V ENDIF @@ -1535,9 +1500,9 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Ha.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOtherStateData%c_obj%Ha_Len = SIZE(DstOtherStateData%Ha) - IF (DstOtherStateData%c_obj%Ha_Len > 0) & - DstOtherStateData%c_obj%Ha = C_LOC( DstOtherStateData%Ha( i1_l ) ) + DstOtherStateData%C_obj%Ha_Len = SIZE(DstOtherStateData%Ha) + IF (DstOtherStateData%C_obj%Ha_Len > 0) & + DstOtherStateData%C_obj%Ha = C_LOC( DstOtherStateData%Ha( i1_l ) ) END IF DstOtherStateData%Ha = SrcOtherStateData%Ha ENDIF @@ -1550,9 +1515,9 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Va.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOtherStateData%c_obj%Va_Len = SIZE(DstOtherStateData%Va) - IF (DstOtherStateData%c_obj%Va_Len > 0) & - DstOtherStateData%c_obj%Va = C_LOC( DstOtherStateData%Va( i1_l ) ) + DstOtherStateData%C_obj%Va_Len = SIZE(DstOtherStateData%Va) + IF (DstOtherStateData%C_obj%Va_Len > 0) & + DstOtherStateData%C_obj%Va = C_LOC( DstOtherStateData%Va( i1_l ) ) END IF DstOtherStateData%Va = SrcOtherStateData%Va ENDIF @@ -1565,9 +1530,9 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOtherStateData%c_obj%x_Len = SIZE(DstOtherStateData%x) - IF (DstOtherStateData%c_obj%x_Len > 0) & - DstOtherStateData%c_obj%x = C_LOC( DstOtherStateData%x( i1_l ) ) + DstOtherStateData%C_obj%x_Len = SIZE(DstOtherStateData%x) + IF (DstOtherStateData%C_obj%x_Len > 0) & + DstOtherStateData%C_obj%x = C_LOC( DstOtherStateData%x( i1_l ) ) END IF DstOtherStateData%x = SrcOtherStateData%x ENDIF @@ -1580,9 +1545,9 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOtherStateData%c_obj%y_Len = SIZE(DstOtherStateData%y) - IF (DstOtherStateData%c_obj%y_Len > 0) & - DstOtherStateData%c_obj%y = C_LOC( DstOtherStateData%y( i1_l ) ) + DstOtherStateData%C_obj%y_Len = SIZE(DstOtherStateData%y) + IF (DstOtherStateData%C_obj%y_Len > 0) & + DstOtherStateData%C_obj%y = C_LOC( DstOtherStateData%y( i1_l ) ) END IF DstOtherStateData%y = SrcOtherStateData%y ENDIF @@ -1595,9 +1560,9 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%z.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOtherStateData%c_obj%z_Len = SIZE(DstOtherStateData%z) - IF (DstOtherStateData%c_obj%z_Len > 0) & - DstOtherStateData%c_obj%z = C_LOC( DstOtherStateData%z( i1_l ) ) + DstOtherStateData%C_obj%z_Len = SIZE(DstOtherStateData%z) + IF (DstOtherStateData%C_obj%z_Len > 0) & + DstOtherStateData%C_obj%z = C_LOC( DstOtherStateData%z( i1_l ) ) END IF DstOtherStateData%z = SrcOtherStateData%z ENDIF @@ -1610,9 +1575,9 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xa.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOtherStateData%c_obj%xa_Len = SIZE(DstOtherStateData%xa) - IF (DstOtherStateData%c_obj%xa_Len > 0) & - DstOtherStateData%c_obj%xa = C_LOC( DstOtherStateData%xa( i1_l ) ) + DstOtherStateData%C_obj%xa_Len = SIZE(DstOtherStateData%xa) + IF (DstOtherStateData%C_obj%xa_Len > 0) & + DstOtherStateData%C_obj%xa = C_LOC( DstOtherStateData%xa( i1_l ) ) END IF DstOtherStateData%xa = SrcOtherStateData%xa ENDIF @@ -1625,9 +1590,9 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%ya.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOtherStateData%c_obj%ya_Len = SIZE(DstOtherStateData%ya) - IF (DstOtherStateData%c_obj%ya_Len > 0) & - DstOtherStateData%c_obj%ya = C_LOC( DstOtherStateData%ya( i1_l ) ) + DstOtherStateData%C_obj%ya_Len = SIZE(DstOtherStateData%ya) + IF (DstOtherStateData%C_obj%ya_Len > 0) & + DstOtherStateData%C_obj%ya = C_LOC( DstOtherStateData%ya( i1_l ) ) END IF DstOtherStateData%ya = SrcOtherStateData%ya ENDIF @@ -1640,9 +1605,9 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%za.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOtherStateData%c_obj%za_Len = SIZE(DstOtherStateData%za) - IF (DstOtherStateData%c_obj%za_Len > 0) & - DstOtherStateData%c_obj%za = C_LOC( DstOtherStateData%za( i1_l ) ) + DstOtherStateData%C_obj%za_Len = SIZE(DstOtherStateData%za) + IF (DstOtherStateData%C_obj%za_Len > 0) & + DstOtherStateData%C_obj%za = C_LOC( DstOtherStateData%za( i1_l ) ) END IF DstOtherStateData%za = SrcOtherStateData%za ENDIF @@ -1655,9 +1620,9 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fx_connect.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOtherStateData%c_obj%Fx_connect_Len = SIZE(DstOtherStateData%Fx_connect) - IF (DstOtherStateData%c_obj%Fx_connect_Len > 0) & - DstOtherStateData%c_obj%Fx_connect = C_LOC( DstOtherStateData%Fx_connect( i1_l ) ) + DstOtherStateData%C_obj%Fx_connect_Len = SIZE(DstOtherStateData%Fx_connect) + IF (DstOtherStateData%C_obj%Fx_connect_Len > 0) & + DstOtherStateData%C_obj%Fx_connect = C_LOC( DstOtherStateData%Fx_connect( i1_l ) ) END IF DstOtherStateData%Fx_connect = SrcOtherStateData%Fx_connect ENDIF @@ -1670,9 +1635,9 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fy_connect.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOtherStateData%c_obj%Fy_connect_Len = SIZE(DstOtherStateData%Fy_connect) - IF (DstOtherStateData%c_obj%Fy_connect_Len > 0) & - DstOtherStateData%c_obj%Fy_connect = C_LOC( DstOtherStateData%Fy_connect( i1_l ) ) + DstOtherStateData%C_obj%Fy_connect_Len = SIZE(DstOtherStateData%Fy_connect) + IF (DstOtherStateData%C_obj%Fy_connect_Len > 0) & + DstOtherStateData%C_obj%Fy_connect = C_LOC( DstOtherStateData%Fy_connect( i1_l ) ) END IF DstOtherStateData%Fy_connect = SrcOtherStateData%Fy_connect ENDIF @@ -1685,9 +1650,9 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fz_connect.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOtherStateData%c_obj%Fz_connect_Len = SIZE(DstOtherStateData%Fz_connect) - IF (DstOtherStateData%c_obj%Fz_connect_Len > 0) & - DstOtherStateData%c_obj%Fz_connect = C_LOC( DstOtherStateData%Fz_connect( i1_l ) ) + DstOtherStateData%C_obj%Fz_connect_Len = SIZE(DstOtherStateData%Fz_connect) + IF (DstOtherStateData%C_obj%Fz_connect_Len > 0) & + DstOtherStateData%C_obj%Fz_connect = C_LOC( DstOtherStateData%Fz_connect( i1_l ) ) END IF DstOtherStateData%Fz_connect = SrcOtherStateData%Fz_connect ENDIF @@ -1700,9 +1665,9 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fx_anchor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOtherStateData%c_obj%Fx_anchor_Len = SIZE(DstOtherStateData%Fx_anchor) - IF (DstOtherStateData%c_obj%Fx_anchor_Len > 0) & - DstOtherStateData%c_obj%Fx_anchor = C_LOC( DstOtherStateData%Fx_anchor( i1_l ) ) + DstOtherStateData%C_obj%Fx_anchor_Len = SIZE(DstOtherStateData%Fx_anchor) + IF (DstOtherStateData%C_obj%Fx_anchor_Len > 0) & + DstOtherStateData%C_obj%Fx_anchor = C_LOC( DstOtherStateData%Fx_anchor( i1_l ) ) END IF DstOtherStateData%Fx_anchor = SrcOtherStateData%Fx_anchor ENDIF @@ -1715,9 +1680,9 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fy_anchor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOtherStateData%c_obj%Fy_anchor_Len = SIZE(DstOtherStateData%Fy_anchor) - IF (DstOtherStateData%c_obj%Fy_anchor_Len > 0) & - DstOtherStateData%c_obj%Fy_anchor = C_LOC( DstOtherStateData%Fy_anchor( i1_l ) ) + DstOtherStateData%C_obj%Fy_anchor_Len = SIZE(DstOtherStateData%Fy_anchor) + IF (DstOtherStateData%C_obj%Fy_anchor_Len > 0) & + DstOtherStateData%C_obj%Fy_anchor = C_LOC( DstOtherStateData%Fy_anchor( i1_l ) ) END IF DstOtherStateData%Fy_anchor = SrcOtherStateData%Fy_anchor ENDIF @@ -1730,22 +1695,20 @@ SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fz_anchor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOtherStateData%c_obj%Fz_anchor_Len = SIZE(DstOtherStateData%Fz_anchor) - IF (DstOtherStateData%c_obj%Fz_anchor_Len > 0) & - DstOtherStateData%c_obj%Fz_anchor = C_LOC( DstOtherStateData%Fz_anchor( i1_l ) ) + DstOtherStateData%C_obj%Fz_anchor_Len = SIZE(DstOtherStateData%Fz_anchor) + IF (DstOtherStateData%C_obj%Fz_anchor_Len > 0) & + DstOtherStateData%C_obj%Fz_anchor = C_LOC( DstOtherStateData%Fz_anchor( i1_l ) ) END IF DstOtherStateData%Fz_anchor = SrcOtherStateData%Fz_anchor ENDIF END SUBROUTINE MAP_CopyOtherState - SUBROUTINE MAP_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MAP_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyOtherState' @@ -1753,121 +1716,83 @@ SUBROUTINE MAP_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ASSOCIATED(OtherStateData%H)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OtherStateData%H) - OtherStateData%H => NULL() OtherStateData%C_obj%H = C_NULL_PTR OtherStateData%C_obj%H_Len = 0 ENDIF IF (ASSOCIATED(OtherStateData%V)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OtherStateData%V) - OtherStateData%V => NULL() OtherStateData%C_obj%V = C_NULL_PTR OtherStateData%C_obj%V_Len = 0 ENDIF IF (ASSOCIATED(OtherStateData%Ha)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OtherStateData%Ha) - OtherStateData%Ha => NULL() OtherStateData%C_obj%Ha = C_NULL_PTR OtherStateData%C_obj%Ha_Len = 0 ENDIF IF (ASSOCIATED(OtherStateData%Va)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OtherStateData%Va) - OtherStateData%Va => NULL() OtherStateData%C_obj%Va = C_NULL_PTR OtherStateData%C_obj%Va_Len = 0 ENDIF IF (ASSOCIATED(OtherStateData%x)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OtherStateData%x) - OtherStateData%x => NULL() OtherStateData%C_obj%x = C_NULL_PTR OtherStateData%C_obj%x_Len = 0 ENDIF IF (ASSOCIATED(OtherStateData%y)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OtherStateData%y) - OtherStateData%y => NULL() OtherStateData%C_obj%y = C_NULL_PTR OtherStateData%C_obj%y_Len = 0 ENDIF IF (ASSOCIATED(OtherStateData%z)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OtherStateData%z) - OtherStateData%z => NULL() OtherStateData%C_obj%z = C_NULL_PTR OtherStateData%C_obj%z_Len = 0 ENDIF IF (ASSOCIATED(OtherStateData%xa)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OtherStateData%xa) - OtherStateData%xa => NULL() OtherStateData%C_obj%xa = C_NULL_PTR OtherStateData%C_obj%xa_Len = 0 ENDIF IF (ASSOCIATED(OtherStateData%ya)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OtherStateData%ya) - OtherStateData%ya => NULL() OtherStateData%C_obj%ya = C_NULL_PTR OtherStateData%C_obj%ya_Len = 0 ENDIF IF (ASSOCIATED(OtherStateData%za)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OtherStateData%za) - OtherStateData%za => NULL() OtherStateData%C_obj%za = C_NULL_PTR OtherStateData%C_obj%za_Len = 0 ENDIF IF (ASSOCIATED(OtherStateData%Fx_connect)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OtherStateData%Fx_connect) - OtherStateData%Fx_connect => NULL() OtherStateData%C_obj%Fx_connect = C_NULL_PTR OtherStateData%C_obj%Fx_connect_Len = 0 ENDIF IF (ASSOCIATED(OtherStateData%Fy_connect)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OtherStateData%Fy_connect) - OtherStateData%Fy_connect => NULL() OtherStateData%C_obj%Fy_connect = C_NULL_PTR OtherStateData%C_obj%Fy_connect_Len = 0 ENDIF IF (ASSOCIATED(OtherStateData%Fz_connect)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OtherStateData%Fz_connect) - OtherStateData%Fz_connect => NULL() OtherStateData%C_obj%Fz_connect = C_NULL_PTR OtherStateData%C_obj%Fz_connect_Len = 0 ENDIF IF (ASSOCIATED(OtherStateData%Fx_anchor)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OtherStateData%Fx_anchor) - OtherStateData%Fx_anchor => NULL() OtherStateData%C_obj%Fx_anchor = C_NULL_PTR OtherStateData%C_obj%Fx_anchor_Len = 0 ENDIF IF (ASSOCIATED(OtherStateData%Fy_anchor)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OtherStateData%Fy_anchor) - OtherStateData%Fy_anchor => NULL() OtherStateData%C_obj%Fy_anchor = C_NULL_PTR OtherStateData%C_obj%Fy_anchor_Len = 0 ENDIF IF (ASSOCIATED(OtherStateData%Fz_anchor)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OtherStateData%Fz_anchor) - OtherStateData%Fz_anchor => NULL() OtherStateData%C_obj%Fz_anchor = C_NULL_PTR OtherStateData%C_obj%Fz_anchor_Len = 0 ENDIF @@ -2299,9 +2224,9 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%H.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%H_Len = SIZE(OutData%H) - IF (OutData%c_obj%H_Len > 0) & - OutData%c_obj%H = C_LOC( OutData%H( i1_l ) ) + OutData%C_obj%H_Len = SIZE(OutData%H) + IF (OutData%C_obj%H_Len > 0) & + OutData%C_obj%H = C_LOC( OutData%H( i1_l ) ) DO i1 = LBOUND(OutData%H,1), UBOUND(OutData%H,1) OutData%H(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -2320,9 +2245,9 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%V_Len = SIZE(OutData%V) - IF (OutData%c_obj%V_Len > 0) & - OutData%c_obj%V = C_LOC( OutData%V( i1_l ) ) + OutData%C_obj%V_Len = SIZE(OutData%V) + IF (OutData%C_obj%V_Len > 0) & + OutData%C_obj%V = C_LOC( OutData%V( i1_l ) ) DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) OutData%V(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -2341,9 +2266,9 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ha.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%Ha_Len = SIZE(OutData%Ha) - IF (OutData%c_obj%Ha_Len > 0) & - OutData%c_obj%Ha = C_LOC( OutData%Ha( i1_l ) ) + OutData%C_obj%Ha_Len = SIZE(OutData%Ha) + IF (OutData%C_obj%Ha_Len > 0) & + OutData%C_obj%Ha = C_LOC( OutData%Ha( i1_l ) ) DO i1 = LBOUND(OutData%Ha,1), UBOUND(OutData%Ha,1) OutData%Ha(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -2362,9 +2287,9 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Va.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%Va_Len = SIZE(OutData%Va) - IF (OutData%c_obj%Va_Len > 0) & - OutData%c_obj%Va = C_LOC( OutData%Va( i1_l ) ) + OutData%C_obj%Va_Len = SIZE(OutData%Va) + IF (OutData%C_obj%Va_Len > 0) & + OutData%C_obj%Va = C_LOC( OutData%Va( i1_l ) ) DO i1 = LBOUND(OutData%Va,1), UBOUND(OutData%Va,1) OutData%Va(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -2383,9 +2308,9 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%x_Len = SIZE(OutData%x) - IF (OutData%c_obj%x_Len > 0) & - OutData%c_obj%x = C_LOC( OutData%x( i1_l ) ) + OutData%C_obj%x_Len = SIZE(OutData%x) + IF (OutData%C_obj%x_Len > 0) & + OutData%C_obj%x = C_LOC( OutData%x( i1_l ) ) DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -2404,9 +2329,9 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%y_Len = SIZE(OutData%y) - IF (OutData%c_obj%y_Len > 0) & - OutData%c_obj%y = C_LOC( OutData%y( i1_l ) ) + OutData%C_obj%y_Len = SIZE(OutData%y) + IF (OutData%C_obj%y_Len > 0) & + OutData%C_obj%y = C_LOC( OutData%y( i1_l ) ) DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -2425,9 +2350,9 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%z_Len = SIZE(OutData%z) - IF (OutData%c_obj%z_Len > 0) & - OutData%c_obj%z = C_LOC( OutData%z( i1_l ) ) + OutData%C_obj%z_Len = SIZE(OutData%z) + IF (OutData%C_obj%z_Len > 0) & + OutData%C_obj%z = C_LOC( OutData%z( i1_l ) ) DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -2446,9 +2371,9 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xa.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%xa_Len = SIZE(OutData%xa) - IF (OutData%c_obj%xa_Len > 0) & - OutData%c_obj%xa = C_LOC( OutData%xa( i1_l ) ) + OutData%C_obj%xa_Len = SIZE(OutData%xa) + IF (OutData%C_obj%xa_Len > 0) & + OutData%C_obj%xa = C_LOC( OutData%xa( i1_l ) ) DO i1 = LBOUND(OutData%xa,1), UBOUND(OutData%xa,1) OutData%xa(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -2467,9 +2392,9 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ya.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%ya_Len = SIZE(OutData%ya) - IF (OutData%c_obj%ya_Len > 0) & - OutData%c_obj%ya = C_LOC( OutData%ya( i1_l ) ) + OutData%C_obj%ya_Len = SIZE(OutData%ya) + IF (OutData%C_obj%ya_Len > 0) & + OutData%C_obj%ya = C_LOC( OutData%ya( i1_l ) ) DO i1 = LBOUND(OutData%ya,1), UBOUND(OutData%ya,1) OutData%ya(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -2488,9 +2413,9 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%za.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%za_Len = SIZE(OutData%za) - IF (OutData%c_obj%za_Len > 0) & - OutData%c_obj%za = C_LOC( OutData%za( i1_l ) ) + OutData%C_obj%za_Len = SIZE(OutData%za) + IF (OutData%C_obj%za_Len > 0) & + OutData%C_obj%za = C_LOC( OutData%za( i1_l ) ) DO i1 = LBOUND(OutData%za,1), UBOUND(OutData%za,1) OutData%za(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -2509,9 +2434,9 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fx_connect.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%Fx_connect_Len = SIZE(OutData%Fx_connect) - IF (OutData%c_obj%Fx_connect_Len > 0) & - OutData%c_obj%Fx_connect = C_LOC( OutData%Fx_connect( i1_l ) ) + OutData%C_obj%Fx_connect_Len = SIZE(OutData%Fx_connect) + IF (OutData%C_obj%Fx_connect_Len > 0) & + OutData%C_obj%Fx_connect = C_LOC( OutData%Fx_connect( i1_l ) ) DO i1 = LBOUND(OutData%Fx_connect,1), UBOUND(OutData%Fx_connect,1) OutData%Fx_connect(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -2530,9 +2455,9 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fy_connect.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%Fy_connect_Len = SIZE(OutData%Fy_connect) - IF (OutData%c_obj%Fy_connect_Len > 0) & - OutData%c_obj%Fy_connect = C_LOC( OutData%Fy_connect( i1_l ) ) + OutData%C_obj%Fy_connect_Len = SIZE(OutData%Fy_connect) + IF (OutData%C_obj%Fy_connect_Len > 0) & + OutData%C_obj%Fy_connect = C_LOC( OutData%Fy_connect( i1_l ) ) DO i1 = LBOUND(OutData%Fy_connect,1), UBOUND(OutData%Fy_connect,1) OutData%Fy_connect(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -2551,9 +2476,9 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fz_connect.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%Fz_connect_Len = SIZE(OutData%Fz_connect) - IF (OutData%c_obj%Fz_connect_Len > 0) & - OutData%c_obj%Fz_connect = C_LOC( OutData%Fz_connect( i1_l ) ) + OutData%C_obj%Fz_connect_Len = SIZE(OutData%Fz_connect) + IF (OutData%C_obj%Fz_connect_Len > 0) & + OutData%C_obj%Fz_connect = C_LOC( OutData%Fz_connect( i1_l ) ) DO i1 = LBOUND(OutData%Fz_connect,1), UBOUND(OutData%Fz_connect,1) OutData%Fz_connect(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -2572,9 +2497,9 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fx_anchor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%Fx_anchor_Len = SIZE(OutData%Fx_anchor) - IF (OutData%c_obj%Fx_anchor_Len > 0) & - OutData%c_obj%Fx_anchor = C_LOC( OutData%Fx_anchor( i1_l ) ) + OutData%C_obj%Fx_anchor_Len = SIZE(OutData%Fx_anchor) + IF (OutData%C_obj%Fx_anchor_Len > 0) & + OutData%C_obj%Fx_anchor = C_LOC( OutData%Fx_anchor( i1_l ) ) DO i1 = LBOUND(OutData%Fx_anchor,1), UBOUND(OutData%Fx_anchor,1) OutData%Fx_anchor(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -2593,9 +2518,9 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fy_anchor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%Fy_anchor_Len = SIZE(OutData%Fy_anchor) - IF (OutData%c_obj%Fy_anchor_Len > 0) & - OutData%c_obj%Fy_anchor = C_LOC( OutData%Fy_anchor( i1_l ) ) + OutData%C_obj%Fy_anchor_Len = SIZE(OutData%Fy_anchor) + IF (OutData%C_obj%Fy_anchor_Len > 0) & + OutData%C_obj%Fy_anchor = C_LOC( OutData%Fy_anchor( i1_l ) ) DO i1 = LBOUND(OutData%Fy_anchor,1), UBOUND(OutData%Fy_anchor,1) OutData%Fy_anchor(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -2614,9 +2539,9 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fz_anchor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%Fz_anchor_Len = SIZE(OutData%Fz_anchor) - IF (OutData%c_obj%Fz_anchor_Len > 0) & - OutData%c_obj%Fz_anchor = C_LOC( OutData%Fz_anchor( i1_l ) ) + OutData%C_obj%Fz_anchor_Len = SIZE(OutData%Fz_anchor) + IF (OutData%C_obj%Fz_anchor_Len > 0) & + OutData%C_obj%Fz_anchor = C_LOC( OutData%Fz_anchor( i1_l ) ) DO i1 = LBOUND(OutData%Fz_anchor,1), UBOUND(OutData%Fz_anchor,1) OutData%Fz_anchor(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -2804,192 +2729,192 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ! -- H OtherState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OtherStateData%H)) THEN - OtherStateData%c_obj%H_Len = 0 - OtherStateData%c_obj%H = C_NULL_PTR + OtherStateData%C_obj%H_Len = 0 + OtherStateData%C_obj%H = C_NULL_PTR ELSE - OtherStateData%c_obj%H_Len = SIZE(OtherStateData%H) - IF (OtherStateData%c_obj%H_Len > 0) & - OtherStateData%c_obj%H = C_LOC( OtherStateData%H( LBOUND(OtherStateData%H,1) ) ) + OtherStateData%C_obj%H_Len = SIZE(OtherStateData%H) + IF (OtherStateData%C_obj%H_Len > 0) & + OtherStateData%C_obj%H = C_LOC( OtherStateData%H( LBOUND(OtherStateData%H,1) ) ) END IF END IF ! -- V OtherState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OtherStateData%V)) THEN - OtherStateData%c_obj%V_Len = 0 - OtherStateData%c_obj%V = C_NULL_PTR + OtherStateData%C_obj%V_Len = 0 + OtherStateData%C_obj%V = C_NULL_PTR ELSE - OtherStateData%c_obj%V_Len = SIZE(OtherStateData%V) - IF (OtherStateData%c_obj%V_Len > 0) & - OtherStateData%c_obj%V = C_LOC( OtherStateData%V( LBOUND(OtherStateData%V,1) ) ) + OtherStateData%C_obj%V_Len = SIZE(OtherStateData%V) + IF (OtherStateData%C_obj%V_Len > 0) & + OtherStateData%C_obj%V = C_LOC( OtherStateData%V( LBOUND(OtherStateData%V,1) ) ) END IF END IF ! -- Ha OtherState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OtherStateData%Ha)) THEN - OtherStateData%c_obj%Ha_Len = 0 - OtherStateData%c_obj%Ha = C_NULL_PTR + OtherStateData%C_obj%Ha_Len = 0 + OtherStateData%C_obj%Ha = C_NULL_PTR ELSE - OtherStateData%c_obj%Ha_Len = SIZE(OtherStateData%Ha) - IF (OtherStateData%c_obj%Ha_Len > 0) & - OtherStateData%c_obj%Ha = C_LOC( OtherStateData%Ha( LBOUND(OtherStateData%Ha,1) ) ) + OtherStateData%C_obj%Ha_Len = SIZE(OtherStateData%Ha) + IF (OtherStateData%C_obj%Ha_Len > 0) & + OtherStateData%C_obj%Ha = C_LOC( OtherStateData%Ha( LBOUND(OtherStateData%Ha,1) ) ) END IF END IF ! -- Va OtherState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OtherStateData%Va)) THEN - OtherStateData%c_obj%Va_Len = 0 - OtherStateData%c_obj%Va = C_NULL_PTR + OtherStateData%C_obj%Va_Len = 0 + OtherStateData%C_obj%Va = C_NULL_PTR ELSE - OtherStateData%c_obj%Va_Len = SIZE(OtherStateData%Va) - IF (OtherStateData%c_obj%Va_Len > 0) & - OtherStateData%c_obj%Va = C_LOC( OtherStateData%Va( LBOUND(OtherStateData%Va,1) ) ) + OtherStateData%C_obj%Va_Len = SIZE(OtherStateData%Va) + IF (OtherStateData%C_obj%Va_Len > 0) & + OtherStateData%C_obj%Va = C_LOC( OtherStateData%Va( LBOUND(OtherStateData%Va,1) ) ) END IF END IF ! -- x OtherState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OtherStateData%x)) THEN - OtherStateData%c_obj%x_Len = 0 - OtherStateData%c_obj%x = C_NULL_PTR + OtherStateData%C_obj%x_Len = 0 + OtherStateData%C_obj%x = C_NULL_PTR ELSE - OtherStateData%c_obj%x_Len = SIZE(OtherStateData%x) - IF (OtherStateData%c_obj%x_Len > 0) & - OtherStateData%c_obj%x = C_LOC( OtherStateData%x( LBOUND(OtherStateData%x,1) ) ) + OtherStateData%C_obj%x_Len = SIZE(OtherStateData%x) + IF (OtherStateData%C_obj%x_Len > 0) & + OtherStateData%C_obj%x = C_LOC( OtherStateData%x( LBOUND(OtherStateData%x,1) ) ) END IF END IF ! -- y OtherState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OtherStateData%y)) THEN - OtherStateData%c_obj%y_Len = 0 - OtherStateData%c_obj%y = C_NULL_PTR + OtherStateData%C_obj%y_Len = 0 + OtherStateData%C_obj%y = C_NULL_PTR ELSE - OtherStateData%c_obj%y_Len = SIZE(OtherStateData%y) - IF (OtherStateData%c_obj%y_Len > 0) & - OtherStateData%c_obj%y = C_LOC( OtherStateData%y( LBOUND(OtherStateData%y,1) ) ) + OtherStateData%C_obj%y_Len = SIZE(OtherStateData%y) + IF (OtherStateData%C_obj%y_Len > 0) & + OtherStateData%C_obj%y = C_LOC( OtherStateData%y( LBOUND(OtherStateData%y,1) ) ) END IF END IF ! -- z OtherState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OtherStateData%z)) THEN - OtherStateData%c_obj%z_Len = 0 - OtherStateData%c_obj%z = C_NULL_PTR + OtherStateData%C_obj%z_Len = 0 + OtherStateData%C_obj%z = C_NULL_PTR ELSE - OtherStateData%c_obj%z_Len = SIZE(OtherStateData%z) - IF (OtherStateData%c_obj%z_Len > 0) & - OtherStateData%c_obj%z = C_LOC( OtherStateData%z( LBOUND(OtherStateData%z,1) ) ) + OtherStateData%C_obj%z_Len = SIZE(OtherStateData%z) + IF (OtherStateData%C_obj%z_Len > 0) & + OtherStateData%C_obj%z = C_LOC( OtherStateData%z( LBOUND(OtherStateData%z,1) ) ) END IF END IF ! -- xa OtherState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OtherStateData%xa)) THEN - OtherStateData%c_obj%xa_Len = 0 - OtherStateData%c_obj%xa = C_NULL_PTR + OtherStateData%C_obj%xa_Len = 0 + OtherStateData%C_obj%xa = C_NULL_PTR ELSE - OtherStateData%c_obj%xa_Len = SIZE(OtherStateData%xa) - IF (OtherStateData%c_obj%xa_Len > 0) & - OtherStateData%c_obj%xa = C_LOC( OtherStateData%xa( LBOUND(OtherStateData%xa,1) ) ) + OtherStateData%C_obj%xa_Len = SIZE(OtherStateData%xa) + IF (OtherStateData%C_obj%xa_Len > 0) & + OtherStateData%C_obj%xa = C_LOC( OtherStateData%xa( LBOUND(OtherStateData%xa,1) ) ) END IF END IF ! -- ya OtherState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OtherStateData%ya)) THEN - OtherStateData%c_obj%ya_Len = 0 - OtherStateData%c_obj%ya = C_NULL_PTR + OtherStateData%C_obj%ya_Len = 0 + OtherStateData%C_obj%ya = C_NULL_PTR ELSE - OtherStateData%c_obj%ya_Len = SIZE(OtherStateData%ya) - IF (OtherStateData%c_obj%ya_Len > 0) & - OtherStateData%c_obj%ya = C_LOC( OtherStateData%ya( LBOUND(OtherStateData%ya,1) ) ) + OtherStateData%C_obj%ya_Len = SIZE(OtherStateData%ya) + IF (OtherStateData%C_obj%ya_Len > 0) & + OtherStateData%C_obj%ya = C_LOC( OtherStateData%ya( LBOUND(OtherStateData%ya,1) ) ) END IF END IF ! -- za OtherState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OtherStateData%za)) THEN - OtherStateData%c_obj%za_Len = 0 - OtherStateData%c_obj%za = C_NULL_PTR + OtherStateData%C_obj%za_Len = 0 + OtherStateData%C_obj%za = C_NULL_PTR ELSE - OtherStateData%c_obj%za_Len = SIZE(OtherStateData%za) - IF (OtherStateData%c_obj%za_Len > 0) & - OtherStateData%c_obj%za = C_LOC( OtherStateData%za( LBOUND(OtherStateData%za,1) ) ) + OtherStateData%C_obj%za_Len = SIZE(OtherStateData%za) + IF (OtherStateData%C_obj%za_Len > 0) & + OtherStateData%C_obj%za = C_LOC( OtherStateData%za( LBOUND(OtherStateData%za,1) ) ) END IF END IF ! -- Fx_connect OtherState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OtherStateData%Fx_connect)) THEN - OtherStateData%c_obj%Fx_connect_Len = 0 - OtherStateData%c_obj%Fx_connect = C_NULL_PTR + OtherStateData%C_obj%Fx_connect_Len = 0 + OtherStateData%C_obj%Fx_connect = C_NULL_PTR ELSE - OtherStateData%c_obj%Fx_connect_Len = SIZE(OtherStateData%Fx_connect) - IF (OtherStateData%c_obj%Fx_connect_Len > 0) & - OtherStateData%c_obj%Fx_connect = C_LOC( OtherStateData%Fx_connect( LBOUND(OtherStateData%Fx_connect,1) ) ) + OtherStateData%C_obj%Fx_connect_Len = SIZE(OtherStateData%Fx_connect) + IF (OtherStateData%C_obj%Fx_connect_Len > 0) & + OtherStateData%C_obj%Fx_connect = C_LOC( OtherStateData%Fx_connect( LBOUND(OtherStateData%Fx_connect,1) ) ) END IF END IF ! -- Fy_connect OtherState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OtherStateData%Fy_connect)) THEN - OtherStateData%c_obj%Fy_connect_Len = 0 - OtherStateData%c_obj%Fy_connect = C_NULL_PTR + OtherStateData%C_obj%Fy_connect_Len = 0 + OtherStateData%C_obj%Fy_connect = C_NULL_PTR ELSE - OtherStateData%c_obj%Fy_connect_Len = SIZE(OtherStateData%Fy_connect) - IF (OtherStateData%c_obj%Fy_connect_Len > 0) & - OtherStateData%c_obj%Fy_connect = C_LOC( OtherStateData%Fy_connect( LBOUND(OtherStateData%Fy_connect,1) ) ) + OtherStateData%C_obj%Fy_connect_Len = SIZE(OtherStateData%Fy_connect) + IF (OtherStateData%C_obj%Fy_connect_Len > 0) & + OtherStateData%C_obj%Fy_connect = C_LOC( OtherStateData%Fy_connect( LBOUND(OtherStateData%Fy_connect,1) ) ) END IF END IF ! -- Fz_connect OtherState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OtherStateData%Fz_connect)) THEN - OtherStateData%c_obj%Fz_connect_Len = 0 - OtherStateData%c_obj%Fz_connect = C_NULL_PTR + OtherStateData%C_obj%Fz_connect_Len = 0 + OtherStateData%C_obj%Fz_connect = C_NULL_PTR ELSE - OtherStateData%c_obj%Fz_connect_Len = SIZE(OtherStateData%Fz_connect) - IF (OtherStateData%c_obj%Fz_connect_Len > 0) & - OtherStateData%c_obj%Fz_connect = C_LOC( OtherStateData%Fz_connect( LBOUND(OtherStateData%Fz_connect,1) ) ) + OtherStateData%C_obj%Fz_connect_Len = SIZE(OtherStateData%Fz_connect) + IF (OtherStateData%C_obj%Fz_connect_Len > 0) & + OtherStateData%C_obj%Fz_connect = C_LOC( OtherStateData%Fz_connect( LBOUND(OtherStateData%Fz_connect,1) ) ) END IF END IF ! -- Fx_anchor OtherState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OtherStateData%Fx_anchor)) THEN - OtherStateData%c_obj%Fx_anchor_Len = 0 - OtherStateData%c_obj%Fx_anchor = C_NULL_PTR + OtherStateData%C_obj%Fx_anchor_Len = 0 + OtherStateData%C_obj%Fx_anchor = C_NULL_PTR ELSE - OtherStateData%c_obj%Fx_anchor_Len = SIZE(OtherStateData%Fx_anchor) - IF (OtherStateData%c_obj%Fx_anchor_Len > 0) & - OtherStateData%c_obj%Fx_anchor = C_LOC( OtherStateData%Fx_anchor( LBOUND(OtherStateData%Fx_anchor,1) ) ) + OtherStateData%C_obj%Fx_anchor_Len = SIZE(OtherStateData%Fx_anchor) + IF (OtherStateData%C_obj%Fx_anchor_Len > 0) & + OtherStateData%C_obj%Fx_anchor = C_LOC( OtherStateData%Fx_anchor( LBOUND(OtherStateData%Fx_anchor,1) ) ) END IF END IF ! -- Fy_anchor OtherState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OtherStateData%Fy_anchor)) THEN - OtherStateData%c_obj%Fy_anchor_Len = 0 - OtherStateData%c_obj%Fy_anchor = C_NULL_PTR + OtherStateData%C_obj%Fy_anchor_Len = 0 + OtherStateData%C_obj%Fy_anchor = C_NULL_PTR ELSE - OtherStateData%c_obj%Fy_anchor_Len = SIZE(OtherStateData%Fy_anchor) - IF (OtherStateData%c_obj%Fy_anchor_Len > 0) & - OtherStateData%c_obj%Fy_anchor = C_LOC( OtherStateData%Fy_anchor( LBOUND(OtherStateData%Fy_anchor,1) ) ) + OtherStateData%C_obj%Fy_anchor_Len = SIZE(OtherStateData%Fy_anchor) + IF (OtherStateData%C_obj%Fy_anchor_Len > 0) & + OtherStateData%C_obj%Fy_anchor = C_LOC( OtherStateData%Fy_anchor( LBOUND(OtherStateData%Fy_anchor,1) ) ) END IF END IF ! -- Fz_anchor OtherState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OtherStateData%Fz_anchor)) THEN - OtherStateData%c_obj%Fz_anchor_Len = 0 - OtherStateData%c_obj%Fz_anchor = C_NULL_PTR + OtherStateData%C_obj%Fz_anchor_Len = 0 + OtherStateData%C_obj%Fz_anchor = C_NULL_PTR ELSE - OtherStateData%c_obj%Fz_anchor_Len = SIZE(OtherStateData%Fz_anchor) - IF (OtherStateData%c_obj%Fz_anchor_Len > 0) & - OtherStateData%c_obj%Fz_anchor = C_LOC( OtherStateData%Fz_anchor( LBOUND(OtherStateData%Fz_anchor,1) ) ) + OtherStateData%C_obj%Fz_anchor_Len = SIZE(OtherStateData%Fz_anchor) + IF (OtherStateData%C_obj%Fz_anchor_Len > 0) & + OtherStateData%C_obj%Fz_anchor = C_LOC( OtherStateData%Fz_anchor( LBOUND(OtherStateData%Fz_anchor,1) ) ) END IF END IF END SUBROUTINE MAP_F2C_CopyOtherState @@ -3018,9 +2943,9 @@ SUBROUTINE MAP_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%H.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstConstrStateData%c_obj%H_Len = SIZE(DstConstrStateData%H) - IF (DstConstrStateData%c_obj%H_Len > 0) & - DstConstrStateData%c_obj%H = C_LOC( DstConstrStateData%H( i1_l ) ) + DstConstrStateData%C_obj%H_Len = SIZE(DstConstrStateData%H) + IF (DstConstrStateData%C_obj%H_Len > 0) & + DstConstrStateData%C_obj%H = C_LOC( DstConstrStateData%H( i1_l ) ) END IF DstConstrStateData%H = SrcConstrStateData%H ENDIF @@ -3033,9 +2958,9 @@ SUBROUTINE MAP_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%V.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstConstrStateData%c_obj%V_Len = SIZE(DstConstrStateData%V) - IF (DstConstrStateData%c_obj%V_Len > 0) & - DstConstrStateData%c_obj%V = C_LOC( DstConstrStateData%V( i1_l ) ) + DstConstrStateData%C_obj%V_Len = SIZE(DstConstrStateData%V) + IF (DstConstrStateData%C_obj%V_Len > 0) & + DstConstrStateData%C_obj%V = C_LOC( DstConstrStateData%V( i1_l ) ) END IF DstConstrStateData%V = SrcConstrStateData%V ENDIF @@ -3048,9 +2973,9 @@ SUBROUTINE MAP_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstConstrStateData%c_obj%x_Len = SIZE(DstConstrStateData%x) - IF (DstConstrStateData%c_obj%x_Len > 0) & - DstConstrStateData%c_obj%x = C_LOC( DstConstrStateData%x( i1_l ) ) + DstConstrStateData%C_obj%x_Len = SIZE(DstConstrStateData%x) + IF (DstConstrStateData%C_obj%x_Len > 0) & + DstConstrStateData%C_obj%x = C_LOC( DstConstrStateData%x( i1_l ) ) END IF DstConstrStateData%x = SrcConstrStateData%x ENDIF @@ -3063,9 +2988,9 @@ SUBROUTINE MAP_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstConstrStateData%c_obj%y_Len = SIZE(DstConstrStateData%y) - IF (DstConstrStateData%c_obj%y_Len > 0) & - DstConstrStateData%c_obj%y = C_LOC( DstConstrStateData%y( i1_l ) ) + DstConstrStateData%C_obj%y_Len = SIZE(DstConstrStateData%y) + IF (DstConstrStateData%C_obj%y_Len > 0) & + DstConstrStateData%C_obj%y = C_LOC( DstConstrStateData%y( i1_l ) ) END IF DstConstrStateData%y = SrcConstrStateData%y ENDIF @@ -3078,22 +3003,20 @@ SUBROUTINE MAP_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%z.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstConstrStateData%c_obj%z_Len = SIZE(DstConstrStateData%z) - IF (DstConstrStateData%c_obj%z_Len > 0) & - DstConstrStateData%c_obj%z = C_LOC( DstConstrStateData%z( i1_l ) ) + DstConstrStateData%C_obj%z_Len = SIZE(DstConstrStateData%z) + IF (DstConstrStateData%C_obj%z_Len > 0) & + DstConstrStateData%C_obj%z = C_LOC( DstConstrStateData%z( i1_l ) ) END IF DstConstrStateData%z = SrcConstrStateData%z ENDIF END SUBROUTINE MAP_CopyConstrState - SUBROUTINE MAP_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MAP_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyConstrState' @@ -3101,44 +3024,28 @@ SUBROUTINE MAP_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ASSOCIATED(ConstrStateData%H)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(ConstrStateData%H) - ConstrStateData%H => NULL() ConstrStateData%C_obj%H = C_NULL_PTR ConstrStateData%C_obj%H_Len = 0 ENDIF IF (ASSOCIATED(ConstrStateData%V)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(ConstrStateData%V) - ConstrStateData%V => NULL() ConstrStateData%C_obj%V = C_NULL_PTR ConstrStateData%C_obj%V_Len = 0 ENDIF IF (ASSOCIATED(ConstrStateData%x)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(ConstrStateData%x) - ConstrStateData%x => NULL() ConstrStateData%C_obj%x = C_NULL_PTR ConstrStateData%C_obj%x_Len = 0 ENDIF IF (ASSOCIATED(ConstrStateData%y)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(ConstrStateData%y) - ConstrStateData%y => NULL() ConstrStateData%C_obj%y = C_NULL_PTR ConstrStateData%C_obj%y_Len = 0 ENDIF IF (ASSOCIATED(ConstrStateData%z)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(ConstrStateData%z) - ConstrStateData%z => NULL() ConstrStateData%C_obj%z = C_NULL_PTR ConstrStateData%C_obj%z_Len = 0 ENDIF @@ -3350,9 +3257,9 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%H.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%H_Len = SIZE(OutData%H) - IF (OutData%c_obj%H_Len > 0) & - OutData%c_obj%H = C_LOC( OutData%H( i1_l ) ) + OutData%C_obj%H_Len = SIZE(OutData%H) + IF (OutData%C_obj%H_Len > 0) & + OutData%C_obj%H = C_LOC( OutData%H( i1_l ) ) DO i1 = LBOUND(OutData%H,1), UBOUND(OutData%H,1) OutData%H(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -3371,9 +3278,9 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%V_Len = SIZE(OutData%V) - IF (OutData%c_obj%V_Len > 0) & - OutData%c_obj%V = C_LOC( OutData%V( i1_l ) ) + OutData%C_obj%V_Len = SIZE(OutData%V) + IF (OutData%C_obj%V_Len > 0) & + OutData%C_obj%V = C_LOC( OutData%V( i1_l ) ) DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) OutData%V(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -3392,9 +3299,9 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%x_Len = SIZE(OutData%x) - IF (OutData%c_obj%x_Len > 0) & - OutData%c_obj%x = C_LOC( OutData%x( i1_l ) ) + OutData%C_obj%x_Len = SIZE(OutData%x) + IF (OutData%C_obj%x_Len > 0) & + OutData%C_obj%x = C_LOC( OutData%x( i1_l ) ) DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -3413,9 +3320,9 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%y_Len = SIZE(OutData%y) - IF (OutData%c_obj%y_Len > 0) & - OutData%c_obj%y = C_LOC( OutData%y( i1_l ) ) + OutData%C_obj%y_Len = SIZE(OutData%y) + IF (OutData%C_obj%y_Len > 0) & + OutData%C_obj%y = C_LOC( OutData%y( i1_l ) ) DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -3434,9 +3341,9 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%z_Len = SIZE(OutData%z) - IF (OutData%c_obj%z_Len > 0) & - OutData%c_obj%z = C_LOC( OutData%z( i1_l ) ) + OutData%C_obj%z_Len = SIZE(OutData%z) + IF (OutData%C_obj%z_Len > 0) & + OutData%C_obj%z = C_LOC( OutData%z( i1_l ) ) DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -3525,60 +3432,60 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe ! -- H ConstrState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(ConstrStateData%H)) THEN - ConstrStateData%c_obj%H_Len = 0 - ConstrStateData%c_obj%H = C_NULL_PTR + ConstrStateData%C_obj%H_Len = 0 + ConstrStateData%C_obj%H = C_NULL_PTR ELSE - ConstrStateData%c_obj%H_Len = SIZE(ConstrStateData%H) - IF (ConstrStateData%c_obj%H_Len > 0) & - ConstrStateData%c_obj%H = C_LOC( ConstrStateData%H( LBOUND(ConstrStateData%H,1) ) ) + ConstrStateData%C_obj%H_Len = SIZE(ConstrStateData%H) + IF (ConstrStateData%C_obj%H_Len > 0) & + ConstrStateData%C_obj%H = C_LOC( ConstrStateData%H( LBOUND(ConstrStateData%H,1) ) ) END IF END IF ! -- V ConstrState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(ConstrStateData%V)) THEN - ConstrStateData%c_obj%V_Len = 0 - ConstrStateData%c_obj%V = C_NULL_PTR + ConstrStateData%C_obj%V_Len = 0 + ConstrStateData%C_obj%V = C_NULL_PTR ELSE - ConstrStateData%c_obj%V_Len = SIZE(ConstrStateData%V) - IF (ConstrStateData%c_obj%V_Len > 0) & - ConstrStateData%c_obj%V = C_LOC( ConstrStateData%V( LBOUND(ConstrStateData%V,1) ) ) + ConstrStateData%C_obj%V_Len = SIZE(ConstrStateData%V) + IF (ConstrStateData%C_obj%V_Len > 0) & + ConstrStateData%C_obj%V = C_LOC( ConstrStateData%V( LBOUND(ConstrStateData%V,1) ) ) END IF END IF ! -- x ConstrState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(ConstrStateData%x)) THEN - ConstrStateData%c_obj%x_Len = 0 - ConstrStateData%c_obj%x = C_NULL_PTR + ConstrStateData%C_obj%x_Len = 0 + ConstrStateData%C_obj%x = C_NULL_PTR ELSE - ConstrStateData%c_obj%x_Len = SIZE(ConstrStateData%x) - IF (ConstrStateData%c_obj%x_Len > 0) & - ConstrStateData%c_obj%x = C_LOC( ConstrStateData%x( LBOUND(ConstrStateData%x,1) ) ) + ConstrStateData%C_obj%x_Len = SIZE(ConstrStateData%x) + IF (ConstrStateData%C_obj%x_Len > 0) & + ConstrStateData%C_obj%x = C_LOC( ConstrStateData%x( LBOUND(ConstrStateData%x,1) ) ) END IF END IF ! -- y ConstrState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(ConstrStateData%y)) THEN - ConstrStateData%c_obj%y_Len = 0 - ConstrStateData%c_obj%y = C_NULL_PTR + ConstrStateData%C_obj%y_Len = 0 + ConstrStateData%C_obj%y = C_NULL_PTR ELSE - ConstrStateData%c_obj%y_Len = SIZE(ConstrStateData%y) - IF (ConstrStateData%c_obj%y_Len > 0) & - ConstrStateData%c_obj%y = C_LOC( ConstrStateData%y( LBOUND(ConstrStateData%y,1) ) ) + ConstrStateData%C_obj%y_Len = SIZE(ConstrStateData%y) + IF (ConstrStateData%C_obj%y_Len > 0) & + ConstrStateData%C_obj%y = C_LOC( ConstrStateData%y( LBOUND(ConstrStateData%y,1) ) ) END IF END IF ! -- z ConstrState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(ConstrStateData%z)) THEN - ConstrStateData%c_obj%z_Len = 0 - ConstrStateData%c_obj%z = C_NULL_PTR + ConstrStateData%C_obj%z_Len = 0 + ConstrStateData%C_obj%z = C_NULL_PTR ELSE - ConstrStateData%c_obj%z_Len = SIZE(ConstrStateData%z) - IF (ConstrStateData%c_obj%z_Len > 0) & - ConstrStateData%c_obj%z = C_LOC( ConstrStateData%z( LBOUND(ConstrStateData%z,1) ) ) + ConstrStateData%C_obj%z_Len = SIZE(ConstrStateData%z) + IF (ConstrStateData%C_obj%z_Len > 0) & + ConstrStateData%C_obj%z = C_LOC( ConstrStateData%z( LBOUND(ConstrStateData%z,1) ) ) END IF END IF END SUBROUTINE MAP_F2C_CopyConstrState @@ -3615,14 +3522,12 @@ SUBROUTINE MAP_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE MAP_CopyParam - SUBROUTINE MAP_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MAP_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyParam' @@ -3630,13 +3535,7 @@ SUBROUTINE MAP_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MAP_Fortran_Destroylin_paramtype( ParamData%LinParams, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_Fortran_DestroyLin_ParamType( ParamData%LinParams, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE MAP_DestroyParam @@ -3684,7 +3583,7 @@ SUBROUTINE MAP_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_BufSz = Int_BufSz + 1 ! numOuts ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! LinParams: size of buffers for each call to pack subtype - CALL MAP_Fortran_Packlin_paramtype( Re_Buf, Db_Buf, Int_Buf, InData%LinParams, ErrStat2, ErrMsg2, .TRUE. ) ! LinParams + CALL MAP_Fortran_PackLin_ParamType( Re_Buf, Db_Buf, Int_Buf, InData%LinParams, ErrStat2, ErrMsg2, .TRUE. ) ! LinParams CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3751,7 +3650,7 @@ SUBROUTINE MAP_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S END DO IntKiBuf(Int_Xferred) = InData%numOuts Int_Xferred = Int_Xferred + 1 - CALL MAP_Fortran_Packlin_paramtype( Re_Buf, Db_Buf, Int_Buf, InData%LinParams, ErrStat2, ErrMsg2, OnlySize ) ! LinParams + CALL MAP_Fortran_PackLin_ParamType( Re_Buf, Db_Buf, Int_Buf, InData%LinParams, ErrStat2, ErrMsg2, OnlySize ) ! LinParams CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3872,7 +3771,7 @@ SUBROUTINE MAP_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_Fortran_Unpacklin_paramtype( Re_Buf, Db_Buf, Int_Buf, OutData%LinParams, ErrStat2, ErrMsg2 ) ! LinParams + CALL MAP_Fortran_UnpackLin_ParamType( Re_Buf, Db_Buf, Int_Buf, OutData%LinParams, ErrStat2, ErrMsg2 ) ! LinParams CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3949,9 +3848,9 @@ SUBROUTINE MAP_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%x_Len = SIZE(DstInputData%x) - IF (DstInputData%c_obj%x_Len > 0) & - DstInputData%c_obj%x = C_LOC( DstInputData%x( i1_l ) ) + DstInputData%C_obj%x_Len = SIZE(DstInputData%x) + IF (DstInputData%C_obj%x_Len > 0) & + DstInputData%C_obj%x = C_LOC( DstInputData%x( i1_l ) ) END IF DstInputData%x = SrcInputData%x ENDIF @@ -3964,9 +3863,9 @@ SUBROUTINE MAP_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%y_Len = SIZE(DstInputData%y) - IF (DstInputData%c_obj%y_Len > 0) & - DstInputData%c_obj%y = C_LOC( DstInputData%y( i1_l ) ) + DstInputData%C_obj%y_Len = SIZE(DstInputData%y) + IF (DstInputData%C_obj%y_Len > 0) & + DstInputData%C_obj%y = C_LOC( DstInputData%y( i1_l ) ) END IF DstInputData%y = SrcInputData%y ENDIF @@ -3979,9 +3878,9 @@ SUBROUTINE MAP_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%z.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%z_Len = SIZE(DstInputData%z) - IF (DstInputData%c_obj%z_Len > 0) & - DstInputData%c_obj%z = C_LOC( DstInputData%z( i1_l ) ) + DstInputData%C_obj%z_Len = SIZE(DstInputData%z) + IF (DstInputData%C_obj%z_Len > 0) & + DstInputData%C_obj%z = C_LOC( DstInputData%z( i1_l ) ) END IF DstInputData%z = SrcInputData%z ENDIF @@ -3990,14 +3889,12 @@ SUBROUTINE MAP_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE MAP_CopyInput - SUBROUTINE MAP_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MAP_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(MAP_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyInput' @@ -4005,30 +3902,18 @@ SUBROUTINE MAP_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ASSOCIATED(InputData%x)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%x) - InputData%x => NULL() InputData%C_obj%x = C_NULL_PTR InputData%C_obj%x_Len = 0 ENDIF IF (ASSOCIATED(InputData%y)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%y) - InputData%y => NULL() InputData%C_obj%y = C_NULL_PTR InputData%C_obj%y_Len = 0 ENDIF IF (ASSOCIATED(InputData%z)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%z) - InputData%z => NULL() InputData%C_obj%z = C_NULL_PTR InputData%C_obj%z_Len = 0 ENDIF @@ -4248,9 +4133,9 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%x_Len = SIZE(OutData%x) - IF (OutData%c_obj%x_Len > 0) & - OutData%c_obj%x = C_LOC( OutData%x( i1_l ) ) + OutData%C_obj%x_Len = SIZE(OutData%x) + IF (OutData%C_obj%x_Len > 0) & + OutData%C_obj%x = C_LOC( OutData%x( i1_l ) ) DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -4269,9 +4154,9 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%y_Len = SIZE(OutData%y) - IF (OutData%c_obj%y_Len > 0) & - OutData%c_obj%y = C_LOC( OutData%y( i1_l ) ) + OutData%C_obj%y_Len = SIZE(OutData%y) + IF (OutData%C_obj%y_Len > 0) & + OutData%C_obj%y = C_LOC( OutData%y( i1_l ) ) DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -4290,9 +4175,9 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%z_Len = SIZE(OutData%z) - IF (OutData%c_obj%z_Len > 0) & - OutData%c_obj%z = C_LOC( OutData%z( i1_l ) ) + OutData%C_obj%z_Len = SIZE(OutData%z) + IF (OutData%C_obj%z_Len > 0) & + OutData%C_obj%z = C_LOC( OutData%z( i1_l ) ) DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -4403,36 +4288,36 @@ SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ! -- x Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%x)) THEN - InputData%c_obj%x_Len = 0 - InputData%c_obj%x = C_NULL_PTR + InputData%C_obj%x_Len = 0 + InputData%C_obj%x = C_NULL_PTR ELSE - InputData%c_obj%x_Len = SIZE(InputData%x) - IF (InputData%c_obj%x_Len > 0) & - InputData%c_obj%x = C_LOC( InputData%x( LBOUND(InputData%x,1) ) ) + InputData%C_obj%x_Len = SIZE(InputData%x) + IF (InputData%C_obj%x_Len > 0) & + InputData%C_obj%x = C_LOC( InputData%x( LBOUND(InputData%x,1) ) ) END IF END IF ! -- y Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%y)) THEN - InputData%c_obj%y_Len = 0 - InputData%c_obj%y = C_NULL_PTR + InputData%C_obj%y_Len = 0 + InputData%C_obj%y = C_NULL_PTR ELSE - InputData%c_obj%y_Len = SIZE(InputData%y) - IF (InputData%c_obj%y_Len > 0) & - InputData%c_obj%y = C_LOC( InputData%y( LBOUND(InputData%y,1) ) ) + InputData%C_obj%y_Len = SIZE(InputData%y) + IF (InputData%C_obj%y_Len > 0) & + InputData%C_obj%y = C_LOC( InputData%y( LBOUND(InputData%y,1) ) ) END IF END IF ! -- z Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%z)) THEN - InputData%c_obj%z_Len = 0 - InputData%c_obj%z = C_NULL_PTR + InputData%C_obj%z_Len = 0 + InputData%C_obj%z = C_NULL_PTR ELSE - InputData%c_obj%z_Len = SIZE(InputData%z) - IF (InputData%c_obj%z_Len > 0) & - InputData%c_obj%z = C_LOC( InputData%z( LBOUND(InputData%z,1) ) ) + InputData%C_obj%z_Len = SIZE(InputData%z) + IF (InputData%C_obj%z_Len > 0) & + InputData%C_obj%z = C_LOC( InputData%z( LBOUND(InputData%z,1) ) ) END IF END IF END SUBROUTINE MAP_F2C_CopyInput @@ -4461,9 +4346,9 @@ SUBROUTINE MAP_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Fx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOutputData%c_obj%Fx_Len = SIZE(DstOutputData%Fx) - IF (DstOutputData%c_obj%Fx_Len > 0) & - DstOutputData%c_obj%Fx = C_LOC( DstOutputData%Fx( i1_l ) ) + DstOutputData%C_obj%Fx_Len = SIZE(DstOutputData%Fx) + IF (DstOutputData%C_obj%Fx_Len > 0) & + DstOutputData%C_obj%Fx = C_LOC( DstOutputData%Fx( i1_l ) ) END IF DstOutputData%Fx = SrcOutputData%Fx ENDIF @@ -4476,9 +4361,9 @@ SUBROUTINE MAP_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Fy.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOutputData%c_obj%Fy_Len = SIZE(DstOutputData%Fy) - IF (DstOutputData%c_obj%Fy_Len > 0) & - DstOutputData%c_obj%Fy = C_LOC( DstOutputData%Fy( i1_l ) ) + DstOutputData%C_obj%Fy_Len = SIZE(DstOutputData%Fy) + IF (DstOutputData%C_obj%Fy_Len > 0) & + DstOutputData%C_obj%Fy = C_LOC( DstOutputData%Fy( i1_l ) ) END IF DstOutputData%Fy = SrcOutputData%Fy ENDIF @@ -4491,9 +4376,9 @@ SUBROUTINE MAP_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Fz.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOutputData%c_obj%Fz_Len = SIZE(DstOutputData%Fz) - IF (DstOutputData%c_obj%Fz_Len > 0) & - DstOutputData%c_obj%Fz = C_LOC( DstOutputData%Fz( i1_l ) ) + DstOutputData%C_obj%Fz_Len = SIZE(DstOutputData%Fz) + IF (DstOutputData%C_obj%Fz_Len > 0) & + DstOutputData%C_obj%Fz = C_LOC( DstOutputData%Fz( i1_l ) ) END IF DstOutputData%Fz = SrcOutputData%Fz ENDIF @@ -4518,9 +4403,9 @@ SUBROUTINE MAP_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%wrtOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOutputData%c_obj%wrtOutput_Len = SIZE(DstOutputData%wrtOutput) - IF (DstOutputData%c_obj%wrtOutput_Len > 0) & - DstOutputData%c_obj%wrtOutput = C_LOC( DstOutputData%wrtOutput( i1_l ) ) + DstOutputData%C_obj%wrtOutput_Len = SIZE(DstOutputData%wrtOutput) + IF (DstOutputData%C_obj%wrtOutput_Len > 0) & + DstOutputData%C_obj%wrtOutput = C_LOC( DstOutputData%wrtOutput( i1_l ) ) END IF DstOutputData%wrtOutput = SrcOutputData%wrtOutput ENDIF @@ -4529,14 +4414,12 @@ SUBROUTINE MAP_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE MAP_CopyOutput - SUBROUTINE MAP_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MAP_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyOutput' @@ -4544,30 +4427,18 @@ SUBROUTINE MAP_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ASSOCIATED(OutputData%Fx)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OutputData%Fx) - OutputData%Fx => NULL() OutputData%C_obj%Fx = C_NULL_PTR OutputData%C_obj%Fx_Len = 0 ENDIF IF (ASSOCIATED(OutputData%Fy)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OutputData%Fy) - OutputData%Fy => NULL() OutputData%C_obj%Fy = C_NULL_PTR OutputData%C_obj%Fy_Len = 0 ENDIF IF (ASSOCIATED(OutputData%Fz)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OutputData%Fz) - OutputData%Fz => NULL() OutputData%C_obj%Fz = C_NULL_PTR OutputData%C_obj%Fz_Len = 0 ENDIF @@ -4575,9 +4446,7 @@ SUBROUTINE MAP_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) DEALLOCATE(OutputData%WriteOutput) ENDIF IF (ASSOCIATED(OutputData%wrtOutput)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OutputData%wrtOutput) - OutputData%wrtOutput => NULL() OutputData%C_obj%wrtOutput = C_NULL_PTR OutputData%C_obj%wrtOutput_Len = 0 ENDIF @@ -4837,9 +4706,9 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%Fx_Len = SIZE(OutData%Fx) - IF (OutData%c_obj%Fx_Len > 0) & - OutData%c_obj%Fx = C_LOC( OutData%Fx( i1_l ) ) + OutData%C_obj%Fx_Len = SIZE(OutData%Fx) + IF (OutData%C_obj%Fx_Len > 0) & + OutData%C_obj%Fx = C_LOC( OutData%Fx( i1_l ) ) DO i1 = LBOUND(OutData%Fx,1), UBOUND(OutData%Fx,1) OutData%Fx(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -4858,9 +4727,9 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fy.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%Fy_Len = SIZE(OutData%Fy) - IF (OutData%c_obj%Fy_Len > 0) & - OutData%c_obj%Fy = C_LOC( OutData%Fy( i1_l ) ) + OutData%C_obj%Fy_Len = SIZE(OutData%Fy) + IF (OutData%C_obj%Fy_Len > 0) & + OutData%C_obj%Fy = C_LOC( OutData%Fy( i1_l ) ) DO i1 = LBOUND(OutData%Fy,1), UBOUND(OutData%Fy,1) OutData%Fy(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -4879,9 +4748,9 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fz.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%Fz_Len = SIZE(OutData%Fz) - IF (OutData%c_obj%Fz_Len > 0) & - OutData%c_obj%Fz = C_LOC( OutData%Fz( i1_l ) ) + OutData%C_obj%Fz_Len = SIZE(OutData%Fz) + IF (OutData%C_obj%Fz_Len > 0) & + OutData%C_obj%Fz = C_LOC( OutData%Fz( i1_l ) ) DO i1 = LBOUND(OutData%Fz,1), UBOUND(OutData%Fz,1) OutData%Fz(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -4918,9 +4787,9 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wrtOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%wrtOutput_Len = SIZE(OutData%wrtOutput) - IF (OutData%c_obj%wrtOutput_Len > 0) & - OutData%c_obj%wrtOutput = C_LOC( OutData%wrtOutput( i1_l ) ) + OutData%C_obj%wrtOutput_Len = SIZE(OutData%wrtOutput) + IF (OutData%C_obj%wrtOutput_Len > 0) & + OutData%C_obj%wrtOutput = C_LOC( OutData%wrtOutput( i1_l ) ) DO i1 = LBOUND(OutData%wrtOutput,1), UBOUND(OutData%wrtOutput,1) OutData%wrtOutput(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 @@ -5040,48 +4909,48 @@ SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ! -- Fx Output Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OutputData%Fx)) THEN - OutputData%c_obj%Fx_Len = 0 - OutputData%c_obj%Fx = C_NULL_PTR + OutputData%C_obj%Fx_Len = 0 + OutputData%C_obj%Fx = C_NULL_PTR ELSE - OutputData%c_obj%Fx_Len = SIZE(OutputData%Fx) - IF (OutputData%c_obj%Fx_Len > 0) & - OutputData%c_obj%Fx = C_LOC( OutputData%Fx( LBOUND(OutputData%Fx,1) ) ) + OutputData%C_obj%Fx_Len = SIZE(OutputData%Fx) + IF (OutputData%C_obj%Fx_Len > 0) & + OutputData%C_obj%Fx = C_LOC( OutputData%Fx( LBOUND(OutputData%Fx,1) ) ) END IF END IF ! -- Fy Output Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OutputData%Fy)) THEN - OutputData%c_obj%Fy_Len = 0 - OutputData%c_obj%Fy = C_NULL_PTR + OutputData%C_obj%Fy_Len = 0 + OutputData%C_obj%Fy = C_NULL_PTR ELSE - OutputData%c_obj%Fy_Len = SIZE(OutputData%Fy) - IF (OutputData%c_obj%Fy_Len > 0) & - OutputData%c_obj%Fy = C_LOC( OutputData%Fy( LBOUND(OutputData%Fy,1) ) ) + OutputData%C_obj%Fy_Len = SIZE(OutputData%Fy) + IF (OutputData%C_obj%Fy_Len > 0) & + OutputData%C_obj%Fy = C_LOC( OutputData%Fy( LBOUND(OutputData%Fy,1) ) ) END IF END IF ! -- Fz Output Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OutputData%Fz)) THEN - OutputData%c_obj%Fz_Len = 0 - OutputData%c_obj%Fz = C_NULL_PTR + OutputData%C_obj%Fz_Len = 0 + OutputData%C_obj%Fz = C_NULL_PTR ELSE - OutputData%c_obj%Fz_Len = SIZE(OutputData%Fz) - IF (OutputData%c_obj%Fz_Len > 0) & - OutputData%c_obj%Fz = C_LOC( OutputData%Fz( LBOUND(OutputData%Fz,1) ) ) + OutputData%C_obj%Fz_Len = SIZE(OutputData%Fz) + IF (OutputData%C_obj%Fz_Len > 0) & + OutputData%C_obj%Fz = C_LOC( OutputData%Fz( LBOUND(OutputData%Fz,1) ) ) END IF END IF ! -- wrtOutput Output Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OutputData%wrtOutput)) THEN - OutputData%c_obj%wrtOutput_Len = 0 - OutputData%c_obj%wrtOutput = C_NULL_PTR + OutputData%C_obj%wrtOutput_Len = 0 + OutputData%C_obj%wrtOutput = C_NULL_PTR ELSE - OutputData%c_obj%wrtOutput_Len = SIZE(OutputData%wrtOutput) - IF (OutputData%c_obj%wrtOutput_Len > 0) & - OutputData%c_obj%wrtOutput = C_LOC( OutputData%wrtOutput( LBOUND(OutputData%wrtOutput,1) ) ) + OutputData%C_obj%wrtOutput_Len = SIZE(OutputData%wrtOutput) + IF (OutputData%C_obj%wrtOutput_Len > 0) & + OutputData%C_obj%wrtOutput = C_LOC( OutputData%wrtOutput( LBOUND(OutputData%wrtOutput,1) ) ) END IF END IF END SUBROUTINE MAP_F2C_CopyOutput diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 873aabf164..127da93d94 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -470,10 +470,6 @@ SUBROUTINE MD_CopyInputFileType( SrcInputFileTypeData, DstInputFileTypeData, Ctr CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyInputFileType' @@ -486,14 +482,12 @@ SUBROUTINE MD_CopyInputFileType( SrcInputFileTypeData, DstInputFileTypeData, Ctr DstInputFileTypeData%threshIC = SrcInputFileTypeData%threshIC END SUBROUTINE MD_CopyInputFileType - SUBROUTINE MD_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MD_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg ) TYPE(MD_InputFileType), INTENT(INOUT) :: InputFileTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyInputFileType' @@ -501,12 +495,6 @@ SUBROUTINE MD_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE MD_DestroyInputFileType SUBROUTINE MD_PackInputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -598,10 +586,6 @@ SUBROUTINE MD_UnPackInputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackInputFileType' @@ -696,14 +680,12 @@ SUBROUTINE MD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%Linearize = SrcInitInputData%Linearize END SUBROUTINE MD_CopyInitInput - SUBROUTINE MD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(MD_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyInitInput' @@ -711,19 +693,13 @@ SUBROUTINE MD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%PtfmInit)) THEN DEALLOCATE(InitInputData%PtfmInit) ENDIF IF (ALLOCATED(InitInputData%TurbineRefPos)) THEN DEALLOCATE(InitInputData%TurbineRefPos) ENDIF - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitInputData%OutList)) THEN DEALLOCATE(InitInputData%OutList) @@ -785,7 +761,7 @@ SUBROUTINE MD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_BufSz = Int_BufSz + 1 ! UsePrimaryInputFile ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! PassedPrimaryInputData: size of buffers for each call to pack subtype - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedPrimaryInputData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedPrimaryInputData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -895,7 +871,7 @@ SUBROUTINE MD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg END DO ! I IntKiBuf(Int_Xferred) = TRANSFER(InData%UsePrimaryInputFile, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, OnlySize ) ! PassedPrimaryInputData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, OnlySize ) ! PassedPrimaryInputData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1073,7 +1049,7 @@ SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackfileinfotype( Re_Buf, Db_Buf, Int_Buf, OutData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) ! PassedPrimaryInputData + CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) ! PassedPrimaryInputData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1146,14 +1122,12 @@ SUBROUTINE MD_CopyLineProp( SrcLinePropData, DstLinePropData, CtrlCode, ErrStat, DstLinePropData%bstiffYs = SrcLinePropData%bstiffYs END SUBROUTINE MD_CopyLineProp - SUBROUTINE MD_DestroyLineProp( LinePropData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MD_DestroyLineProp( LinePropData, ErrStat, ErrMsg ) TYPE(MD_LineProp), INTENT(INOUT) :: LinePropData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyLineProp' @@ -1161,12 +1135,6 @@ SUBROUTINE MD_DestroyLineProp( LinePropData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE MD_DestroyLineProp SUBROUTINE MD_PackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1443,14 +1411,12 @@ SUBROUTINE MD_CopyRodProp( SrcRodPropData, DstRodPropData, CtrlCode, ErrStat, Er DstRodPropData%CaEnd = SrcRodPropData%CaEnd END SUBROUTINE MD_CopyRodProp - SUBROUTINE MD_DestroyRodProp( RodPropData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MD_DestroyRodProp( RodPropData, ErrStat, ErrMsg ) TYPE(MD_RodProp), INTENT(INOUT) :: RodPropData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyRodProp' @@ -1458,12 +1424,6 @@ SUBROUTINE MD_DestroyRodProp( RodPropData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE MD_DestroyRodProp SUBROUTINE MD_PackRodProp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1656,14 +1616,12 @@ SUBROUTINE MD_CopyBody( SrcBodyData, DstBodyData, CtrlCode, ErrStat, ErrMsg ) DstBodyData%rCG = SrcBodyData%rCG END SUBROUTINE MD_CopyBody - SUBROUTINE MD_DestroyBody( BodyData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MD_DestroyBody( BodyData, ErrStat, ErrMsg ) TYPE(MD_Body), INTENT(INOUT) :: BodyData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyBody' @@ -1671,12 +1629,6 @@ SUBROUTINE MD_DestroyBody( BodyData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE MD_DestroyBody SUBROUTINE MD_PackBody( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2099,14 +2051,12 @@ SUBROUTINE MD_CopyConnect( SrcConnectData, DstConnectData, CtrlCode, ErrStat, Er DstConnectData%M = SrcConnectData%M END SUBROUTINE MD_CopyConnect - SUBROUTINE MD_DestroyConnect( ConnectData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MD_DestroyConnect( ConnectData, ErrStat, ErrMsg ) TYPE(MD_Connect), INTENT(INOUT) :: ConnectData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyConnect' @@ -2114,12 +2064,6 @@ SUBROUTINE MD_DestroyConnect( ConnectData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ConnectData%PDyn)) THEN DEALLOCATE(ConnectData%PDyn) ENDIF @@ -2747,14 +2691,12 @@ SUBROUTINE MD_CopyRod( SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE MD_CopyRod - SUBROUTINE MD_DestroyRod( RodData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MD_DestroyRod( RodData, ErrStat, ErrMsg ) TYPE(MD_Rod), INTENT(INOUT) :: RodData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyRod' @@ -2762,12 +2704,6 @@ SUBROUTINE MD_DestroyRod( RodData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(RodData%r)) THEN DEALLOCATE(RodData%r) ENDIF @@ -4525,14 +4461,12 @@ SUBROUTINE MD_CopyLine( SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE MD_CopyLine - SUBROUTINE MD_DestroyLine( LineData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MD_DestroyLine( LineData, ErrStat, ErrMsg ) TYPE(MD_Line), INTENT(INOUT) :: LineData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyLine' @@ -4540,12 +4474,6 @@ SUBROUTINE MD_DestroyLine( LineData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(LineData%r)) THEN DEALLOCATE(LineData%r) ENDIF @@ -6237,14 +6165,12 @@ SUBROUTINE MD_CopyFail( SrcFailData, DstFailData, CtrlCode, ErrStat, ErrMsg ) DstFailData%IdNum = SrcFailData%IdNum END SUBROUTINE MD_CopyFail - SUBROUTINE MD_DestroyFail( FailData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MD_DestroyFail( FailData, ErrStat, ErrMsg ) TYPE(MD_Fail), INTENT(INOUT) :: FailData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyFail' @@ -6252,12 +6178,6 @@ SUBROUTINE MD_DestroyFail( FailData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE MD_DestroyFail SUBROUTINE MD_PackFail( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -6379,14 +6299,12 @@ SUBROUTINE MD_CopyOutParmType( SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, DstOutParmTypeData%ObjID = SrcOutParmTypeData%ObjID END SUBROUTINE MD_CopyOutParmType - SUBROUTINE MD_DestroyOutParmType( OutParmTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MD_DestroyOutParmType( OutParmTypeData, ErrStat, ErrMsg ) TYPE(MD_OutParmType), INTENT(INOUT) :: OutParmTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyOutParmType' @@ -6394,12 +6312,6 @@ SUBROUTINE MD_DestroyOutParmType( OutParmTypeData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE MD_DestroyOutParmType SUBROUTINE MD_PackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -6684,14 +6596,12 @@ SUBROUTINE MD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er ENDIF END SUBROUTINE MD_CopyInitOutput - SUBROUTINE MD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(MD_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyInitOutput' @@ -6699,19 +6609,13 @@ SUBROUTINE MD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%writeOutputHdr)) THEN DEALLOCATE(InitOutputData%writeOutputHdr) ENDIF IF (ALLOCATED(InitOutputData%writeOutputUnt)) THEN DEALLOCATE(InitOutputData%writeOutputUnt) ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitOutputData%CableCChanRqst)) THEN DEALLOCATE(InitOutputData%CableCChanRqst) @@ -6789,7 +6693,7 @@ SUBROUTINE MD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6911,7 +6815,7 @@ SUBROUTINE MD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END DO ! I END DO END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7182,7 +7086,7 @@ SUBROUTINE MD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7388,14 +7292,12 @@ SUBROUTINE MD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrSt ENDIF END SUBROUTINE MD_CopyContState - SUBROUTINE MD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MD_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(MD_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyContState' @@ -7403,12 +7305,6 @@ SUBROUTINE MD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ContStateData%states)) THEN DEALLOCATE(ContStateData%states) ENDIF @@ -7562,14 +7458,12 @@ SUBROUTINE MD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt DstDiscStateData%dummy = SrcDiscStateData%dummy END SUBROUTINE MD_CopyDiscState - SUBROUTINE MD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(MD_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyDiscState' @@ -7577,12 +7471,6 @@ SUBROUTINE MD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE MD_DestroyDiscState SUBROUTINE MD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -7699,14 +7587,12 @@ SUBROUTINE MD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%dummy = SrcConstrStateData%dummy END SUBROUTINE MD_CopyConstrState - SUBROUTINE MD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(MD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyConstrState' @@ -7714,12 +7600,6 @@ SUBROUTINE MD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE MD_DestroyConstrState SUBROUTINE MD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -7836,14 +7716,12 @@ SUBROUTINE MD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%dummy = SrcOtherStateData%dummy END SUBROUTINE MD_CopyOtherState - SUBROUTINE MD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(MD_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyOtherState' @@ -7851,12 +7729,6 @@ SUBROUTINE MD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE MD_DestroyOtherState SUBROUTINE MD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -8336,14 +8208,12 @@ SUBROUTINE MD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE MD_CopyMisc - SUBROUTINE MD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MD_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(MD_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyMisc' @@ -8351,59 +8221,53 @@ SUBROUTINE MD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MiscData%LineTypeList)) THEN DO i1 = LBOUND(MiscData%LineTypeList,1), UBOUND(MiscData%LineTypeList,1) - CALL MD_Destroylineprop( MiscData%LineTypeList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyLineProp( MiscData%LineTypeList(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%LineTypeList) ENDIF IF (ALLOCATED(MiscData%RodTypeList)) THEN DO i1 = LBOUND(MiscData%RodTypeList,1), UBOUND(MiscData%RodTypeList,1) - CALL MD_Destroyrodprop( MiscData%RodTypeList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyRodProp( MiscData%RodTypeList(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%RodTypeList) ENDIF - CALL MD_Destroybody( MiscData%GroundBody, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyBody( MiscData%GroundBody, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MiscData%BodyList)) THEN DO i1 = LBOUND(MiscData%BodyList,1), UBOUND(MiscData%BodyList,1) - CALL MD_Destroybody( MiscData%BodyList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyBody( MiscData%BodyList(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%BodyList) ENDIF IF (ALLOCATED(MiscData%RodList)) THEN DO i1 = LBOUND(MiscData%RodList,1), UBOUND(MiscData%RodList,1) - CALL MD_Destroyrod( MiscData%RodList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyRod( MiscData%RodList(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%RodList) ENDIF IF (ALLOCATED(MiscData%ConnectList)) THEN DO i1 = LBOUND(MiscData%ConnectList,1), UBOUND(MiscData%ConnectList,1) - CALL MD_Destroyconnect( MiscData%ConnectList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyConnect( MiscData%ConnectList(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%ConnectList) ENDIF IF (ALLOCATED(MiscData%LineList)) THEN DO i1 = LBOUND(MiscData%LineList,1), UBOUND(MiscData%LineList,1) - CALL MD_Destroyline( MiscData%LineList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyLine( MiscData%LineList(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%LineList) ENDIF IF (ALLOCATED(MiscData%FailList)) THEN DO i1 = LBOUND(MiscData%FailList,1), UBOUND(MiscData%FailList,1) - CALL MD_Destroyfail( MiscData%FailList(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyFail( MiscData%FailList(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%FailList) @@ -8450,9 +8314,9 @@ SUBROUTINE MD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(MiscData%BodyStateIsN)) THEN DEALLOCATE(MiscData%BodyStateIsN) ENDIF - CALL MD_DestroyContState( MiscData%xTemp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyContState( MiscData%xTemp, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyContState( MiscData%xdTemp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyContState( MiscData%xdTemp, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MiscData%MDWrOutput)) THEN DEALLOCATE(MiscData%MDWrOutput) @@ -8512,7 +8376,7 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%LineTypeList,1), UBOUND(InData%LineTypeList,1) Int_BufSz = Int_BufSz + 3 ! LineTypeList: size of buffers for each call to pack subtype - CALL MD_Packlineprop( Re_Buf, Db_Buf, Int_Buf, InData%LineTypeList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LineTypeList + CALL MD_PackLineProp( Re_Buf, Db_Buf, Int_Buf, InData%LineTypeList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LineTypeList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8535,7 +8399,7 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_BufSz = Int_BufSz + 2*1 ! RodTypeList upper/lower bounds for each dimension DO i1 = LBOUND(InData%RodTypeList,1), UBOUND(InData%RodTypeList,1) Int_BufSz = Int_BufSz + 3 ! RodTypeList: size of buffers for each call to pack subtype - CALL MD_Packrodprop( Re_Buf, Db_Buf, Int_Buf, InData%RodTypeList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! RodTypeList + CALL MD_PackRodProp( Re_Buf, Db_Buf, Int_Buf, InData%RodTypeList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! RodTypeList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8554,7 +8418,7 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz END DO END IF Int_BufSz = Int_BufSz + 3 ! GroundBody: size of buffers for each call to pack subtype - CALL MD_Packbody( Re_Buf, Db_Buf, Int_Buf, InData%GroundBody, ErrStat2, ErrMsg2, .TRUE. ) ! GroundBody + CALL MD_PackBody( Re_Buf, Db_Buf, Int_Buf, InData%GroundBody, ErrStat2, ErrMsg2, .TRUE. ) ! GroundBody CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8575,7 +8439,7 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_BufSz = Int_BufSz + 2*1 ! BodyList upper/lower bounds for each dimension DO i1 = LBOUND(InData%BodyList,1), UBOUND(InData%BodyList,1) Int_BufSz = Int_BufSz + 3 ! BodyList: size of buffers for each call to pack subtype - CALL MD_Packbody( Re_Buf, Db_Buf, Int_Buf, InData%BodyList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BodyList + CALL MD_PackBody( Re_Buf, Db_Buf, Int_Buf, InData%BodyList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BodyList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8598,7 +8462,7 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_BufSz = Int_BufSz + 2*1 ! RodList upper/lower bounds for each dimension DO i1 = LBOUND(InData%RodList,1), UBOUND(InData%RodList,1) Int_BufSz = Int_BufSz + 3 ! RodList: size of buffers for each call to pack subtype - CALL MD_Packrod( Re_Buf, Db_Buf, Int_Buf, InData%RodList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! RodList + CALL MD_PackRod( Re_Buf, Db_Buf, Int_Buf, InData%RodList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! RodList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8621,7 +8485,7 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_BufSz = Int_BufSz + 2*1 ! ConnectList upper/lower bounds for each dimension DO i1 = LBOUND(InData%ConnectList,1), UBOUND(InData%ConnectList,1) Int_BufSz = Int_BufSz + 3 ! ConnectList: size of buffers for each call to pack subtype - CALL MD_Packconnect( Re_Buf, Db_Buf, Int_Buf, InData%ConnectList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ConnectList + CALL MD_PackConnect( Re_Buf, Db_Buf, Int_Buf, InData%ConnectList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ConnectList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8644,7 +8508,7 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_BufSz = Int_BufSz + 2*1 ! LineList upper/lower bounds for each dimension DO i1 = LBOUND(InData%LineList,1), UBOUND(InData%LineList,1) Int_BufSz = Int_BufSz + 3 ! LineList: size of buffers for each call to pack subtype - CALL MD_Packline( Re_Buf, Db_Buf, Int_Buf, InData%LineList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LineList + CALL MD_PackLine( Re_Buf, Db_Buf, Int_Buf, InData%LineList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LineList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8667,7 +8531,7 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_BufSz = Int_BufSz + 2*1 ! FailList upper/lower bounds for each dimension DO i1 = LBOUND(InData%FailList,1), UBOUND(InData%FailList,1) Int_BufSz = Int_BufSz + 3 ! FailList: size of buffers for each call to pack subtype - CALL MD_Packfail( Re_Buf, Db_Buf, Int_Buf, InData%FailList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FailList + CALL MD_PackFail( Re_Buf, Db_Buf, Int_Buf, InData%FailList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FailList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8857,7 +8721,7 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%LineTypeList,1), UBOUND(InData%LineTypeList,1) - CALL MD_Packlineprop( Re_Buf, Db_Buf, Int_Buf, InData%LineTypeList(i1), ErrStat2, ErrMsg2, OnlySize ) ! LineTypeList + CALL MD_PackLineProp( Re_Buf, Db_Buf, Int_Buf, InData%LineTypeList(i1), ErrStat2, ErrMsg2, OnlySize ) ! LineTypeList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8898,7 +8762,7 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%RodTypeList,1), UBOUND(InData%RodTypeList,1) - CALL MD_Packrodprop( Re_Buf, Db_Buf, Int_Buf, InData%RodTypeList(i1), ErrStat2, ErrMsg2, OnlySize ) ! RodTypeList + CALL MD_PackRodProp( Re_Buf, Db_Buf, Int_Buf, InData%RodTypeList(i1), ErrStat2, ErrMsg2, OnlySize ) ! RodTypeList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8928,7 +8792,7 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz ENDIF END DO END IF - CALL MD_Packbody( Re_Buf, Db_Buf, Int_Buf, InData%GroundBody, ErrStat2, ErrMsg2, OnlySize ) ! GroundBody + CALL MD_PackBody( Re_Buf, Db_Buf, Int_Buf, InData%GroundBody, ErrStat2, ErrMsg2, OnlySize ) ! GroundBody CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8967,7 +8831,7 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%BodyList,1), UBOUND(InData%BodyList,1) - CALL MD_Packbody( Re_Buf, Db_Buf, Int_Buf, InData%BodyList(i1), ErrStat2, ErrMsg2, OnlySize ) ! BodyList + CALL MD_PackBody( Re_Buf, Db_Buf, Int_Buf, InData%BodyList(i1), ErrStat2, ErrMsg2, OnlySize ) ! BodyList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9008,7 +8872,7 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%RodList,1), UBOUND(InData%RodList,1) - CALL MD_Packrod( Re_Buf, Db_Buf, Int_Buf, InData%RodList(i1), ErrStat2, ErrMsg2, OnlySize ) ! RodList + CALL MD_PackRod( Re_Buf, Db_Buf, Int_Buf, InData%RodList(i1), ErrStat2, ErrMsg2, OnlySize ) ! RodList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9049,7 +8913,7 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%ConnectList,1), UBOUND(InData%ConnectList,1) - CALL MD_Packconnect( Re_Buf, Db_Buf, Int_Buf, InData%ConnectList(i1), ErrStat2, ErrMsg2, OnlySize ) ! ConnectList + CALL MD_PackConnect( Re_Buf, Db_Buf, Int_Buf, InData%ConnectList(i1), ErrStat2, ErrMsg2, OnlySize ) ! ConnectList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9090,7 +8954,7 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%LineList,1), UBOUND(InData%LineList,1) - CALL MD_Packline( Re_Buf, Db_Buf, Int_Buf, InData%LineList(i1), ErrStat2, ErrMsg2, OnlySize ) ! LineList + CALL MD_PackLine( Re_Buf, Db_Buf, Int_Buf, InData%LineList(i1), ErrStat2, ErrMsg2, OnlySize ) ! LineList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9131,7 +8995,7 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%FailList,1), UBOUND(InData%FailList,1) - CALL MD_Packfail( Re_Buf, Db_Buf, Int_Buf, InData%FailList(i1), ErrStat2, ErrMsg2, OnlySize ) ! FailList + CALL MD_PackFail( Re_Buf, Db_Buf, Int_Buf, InData%FailList(i1), ErrStat2, ErrMsg2, OnlySize ) ! FailList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9613,7 +9477,7 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_Unpacklineprop( Re_Buf, Db_Buf, Int_Buf, OutData%LineTypeList(i1), ErrStat2, ErrMsg2 ) ! LineTypeList + CALL MD_UnpackLineProp( Re_Buf, Db_Buf, Int_Buf, OutData%LineTypeList(i1), ErrStat2, ErrMsg2 ) ! LineTypeList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9669,7 +9533,7 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_Unpackrodprop( Re_Buf, Db_Buf, Int_Buf, OutData%RodTypeList(i1), ErrStat2, ErrMsg2 ) ! RodTypeList + CALL MD_UnpackRodProp( Re_Buf, Db_Buf, Int_Buf, OutData%RodTypeList(i1), ErrStat2, ErrMsg2 ) ! RodTypeList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9711,7 +9575,7 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_Unpackbody( Re_Buf, Db_Buf, Int_Buf, OutData%GroundBody, ErrStat2, ErrMsg2 ) ! GroundBody + CALL MD_UnpackBody( Re_Buf, Db_Buf, Int_Buf, OutData%GroundBody, ErrStat2, ErrMsg2 ) ! GroundBody CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9765,7 +9629,7 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_Unpackbody( Re_Buf, Db_Buf, Int_Buf, OutData%BodyList(i1), ErrStat2, ErrMsg2 ) ! BodyList + CALL MD_UnpackBody( Re_Buf, Db_Buf, Int_Buf, OutData%BodyList(i1), ErrStat2, ErrMsg2 ) ! BodyList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9821,7 +9685,7 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_Unpackrod( Re_Buf, Db_Buf, Int_Buf, OutData%RodList(i1), ErrStat2, ErrMsg2 ) ! RodList + CALL MD_UnpackRod( Re_Buf, Db_Buf, Int_Buf, OutData%RodList(i1), ErrStat2, ErrMsg2 ) ! RodList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9877,7 +9741,7 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_Unpackconnect( Re_Buf, Db_Buf, Int_Buf, OutData%ConnectList(i1), ErrStat2, ErrMsg2 ) ! ConnectList + CALL MD_UnpackConnect( Re_Buf, Db_Buf, Int_Buf, OutData%ConnectList(i1), ErrStat2, ErrMsg2 ) ! ConnectList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9933,7 +9797,7 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_Unpackline( Re_Buf, Db_Buf, Int_Buf, OutData%LineList(i1), ErrStat2, ErrMsg2 ) ! LineList + CALL MD_UnpackLine( Re_Buf, Db_Buf, Int_Buf, OutData%LineList(i1), ErrStat2, ErrMsg2 ) ! LineList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9989,7 +9853,7 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_Unpackfail( Re_Buf, Db_Buf, Int_Buf, OutData%FailList(i1), ErrStat2, ErrMsg2 ) ! FailList + CALL MD_UnpackFail( Re_Buf, Db_Buf, Int_Buf, OutData%FailList(i1), ErrStat2, ErrMsg2 ) ! FailList CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10856,14 +10720,12 @@ SUBROUTINE MD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE MD_CopyParam - SUBROUTINE MD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MD_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(MD_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyParam' @@ -10871,12 +10733,6 @@ SUBROUTINE MD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%nCpldBodies)) THEN DEALLOCATE(ParamData%nCpldBodies) ENDIF @@ -10888,7 +10744,7 @@ SUBROUTINE MD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL MD_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) @@ -11033,7 +10889,7 @@ SUBROUTINE MD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL MD_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL MD_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11302,7 +11158,7 @@ SUBROUTINE MD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL MD_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL MD_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11973,7 +11829,7 @@ SUBROUTINE MD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL MD_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12554,14 +12410,12 @@ SUBROUTINE MD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE MD_CopyInput - SUBROUTINE MD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MD_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(MD_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyInput' @@ -12569,12 +12423,6 @@ SUBROUTINE MD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputData%CoupledKinematics)) THEN DO i1 = LBOUND(InputData%CoupledKinematics,1), UBOUND(InputData%CoupledKinematics,1) CALL MeshDestroy( InputData%CoupledKinematics(i1), ErrStat2, ErrMsg2 ) @@ -12925,14 +12773,12 @@ SUBROUTINE MD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs ENDIF END SUBROUTINE MD_CopyOutput - SUBROUTINE MD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE MD_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(MD_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyOutput' @@ -12940,12 +12786,6 @@ SUBROUTINE MD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%CoupledLoads)) THEN DO i1 = LBOUND(OutputData%CoupledLoads,1), UBOUND(OutputData%CoupledLoads,1) CALL MeshDestroy( OutputData%CoupledLoads(i1), ErrStat2, ErrMsg2 ) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index d91a3cfb14..d9df73fdce 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -1576,7 +1576,7 @@ SUBROUTINE Cleanup() !............................................................................................................................... ! We assume that all initializion data points to parameter data, so we just nullify the pointers instead of deallocate ! data that they point to: - CALL FAST_DestroyInitData( Init, ErrStat2, ErrMsg2, DEALLOCATEpointers=.false. ) + CALL FAST_DestroyInitData( Init, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END SUBROUTINE Cleanup diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 63893b4018..8099076070 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -34,10 +34,10 @@ MODULE FAST_Types USE ElastoDyn_Types USE BeamDyn_Types USE ServoDyn_Types -USE InflowWind_Types USE AeroDyn14_Types USE AeroDyn_Types USE SubDyn_Types +USE SeaState_Types USE HydroDyn_Types USE IceFloe_Types USE OpenFOAM_Types @@ -112,8 +112,8 @@ MODULE FAST_Types ! ========= FAST_ParameterType ======= TYPE, PUBLIC :: FAST_ParameterType REAL(DbKi) :: DT !< Integration time step [global time] [s] - REAL(DbKi) , DIMENSION(NumModules) :: DT_module !< Integration time step [global time] [s] - INTEGER(IntKi) , DIMENSION(NumModules) :: n_substeps !< The number of module substeps for advancing states from t_global to t_global_next [-] + REAL(DbKi) , DIMENSION(1:NumModules) :: DT_module !< Integration time step [global time] [s] + INTEGER(IntKi) , DIMENSION(1:NumModules) :: n_substeps !< The number of module substeps for advancing states from t_global to t_global_next [-] INTEGER(IntKi) :: n_TMax_m1 !< The time step of TMax - dt (the end time of the simulation) [(-)] REAL(DbKi) :: TMax !< Total run time [s] INTEGER(IntKi) :: InterpOrder !< Interpolation order {0,1,2} [-] @@ -122,7 +122,7 @@ MODULE FAST_Types INTEGER(IntKi) :: numIceLegs !< number of suport-structure legs in contact with ice (IceDyn coupling) [-] INTEGER(IntKi) :: nBeams !< number of BeamDyn instances [-] LOGICAL :: BD_OutputSibling !< flag to determine if BD input is sibling of output mesh [-] - LOGICAL , DIMENSION(NumModules) :: ModuleInitialized !< An array determining if the module has been initialized [-] + LOGICAL , DIMENSION(1:NumModules) :: ModuleInitialized !< An array determining if the module has been initialized [-] REAL(DbKi) :: DT_Ujac !< Time between when we need to re-calculate these Jacobians [s] REAL(ReKi) :: UJacSclFact !< Scaling factor used to get similar magnitudes between accelerations, forces, and moments in Jacobians [-] INTEGER(IntKi) , DIMENSION(1:9) :: SizeJac_Opt1 !< (1)=size of matrix; (2)=size of ED portion; (3)=size of SD portion [2 meshes]; (4)=size of HD portion; (5)=size of BD portion blade 1; (6)=size of BD portion blade 2; (7)=size of BD portion blade 3; (8)=size of Orca portion; (9)=size of ExtPtfm portion; [-] @@ -152,7 +152,7 @@ MODULE FAST_Types REAL(ReKi) :: WtrDpth !< Water depth [m] REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] CHARACTER(1024) :: EDFile !< The name of the ElastoDyn input file [-] - CHARACTER(1024) , DIMENSION(MaxNBlades) :: BDBldFile !< Name of files containing BeamDyn inputs for each blade [-] + CHARACTER(1024) , DIMENSION(1:MaxNBlades) :: BDBldFile !< Name of files containing BeamDyn inputs for each blade [-] CHARACTER(1024) :: InflowFile !< Name of file containing inflow wind input parameters [-] CHARACTER(1024) :: AeroFile !< Name of file containing aerodynamic input parameters [-] CHARACTER(1024) :: ServoFile !< Name of file containing control and electrical-drive input parameters [-] @@ -203,7 +203,7 @@ MODULE FAST_Types TYPE(FAST_VTK_ModeShapeType) :: VTK_modes !< Data for VTK mode-shape visualization [-] LOGICAL :: UseSC !< Use Supercontroller [-] INTEGER(IntKi) :: Lin_NumMods !< number of modules in the linearization [-] - INTEGER(IntKi) , DIMENSION(NumModules) :: Lin_ModOrder !< indices that determine which order the modules are in the glue-code linearization matrix [-] + INTEGER(IntKi) , DIMENSION(1:NumModules) :: Lin_ModOrder !< indices that determine which order the modules are in the glue-code linearization matrix [-] INTEGER(IntKi) :: LinInterpOrder !< Interpolation order for CalcSteady solution [-] END TYPE FAST_ParameterType ! ======================= @@ -317,7 +317,7 @@ MODULE FAST_Types ! ======================= ! ========= FAST_LinFileType ======= TYPE, PUBLIC :: FAST_LinFileType - TYPE(FAST_ModLinType) , DIMENSION(NumModules) :: Modules !< Linearization data for each module [-] + TYPE(FAST_ModLinType) , DIMENSION(1:NumModules) :: Modules !< Linearization data for each module [-] TYPE(FAST_LinType) :: Glue !< Linearization data for the glue code (coupled system) [-] REAL(ReKi) :: RotSpeed !< Rotor azimuth angular speed [rad/s] REAL(ReKi) :: Azimuth !< Rotor azimuth position [rad] @@ -347,15 +347,15 @@ MODULE FAST_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AllOutData !< Array to contain all the output data (time history of all outputs); Index 1 is NumOuts, Index 2 is Time step [-] INTEGER(IntKi) :: n_Out !< Time index into the AllOutData array [-] INTEGER(IntKi) :: NOutSteps !< Maximum number of output steps [-] - INTEGER(IntKi) , DIMENSION(NumModules) :: numOuts !< number of outputs to print from each module [-] + INTEGER(IntKi) , DIMENSION(1:NumModules) :: numOuts !< number of outputs to print from each module [-] INTEGER(IntKi) :: UnOu = -1 !< I/O unit number for the tabular output file [-] INTEGER(IntKi) :: UnSum = -1 !< I/O unit number for the summary file [-] INTEGER(IntKi) :: UnGra = -1 !< I/O unit number for mesh graphics [-] CHARACTER(1024) , DIMENSION(1:3) :: FileDescLines !< Description lines to include in output files (header, time run, plus module names/versions) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ChannelNames !< Names of the output channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ChannelUnits !< Units for the output channels [-] - TYPE(ProgDesc) , DIMENSION(NumModules) :: Module_Ver !< version information from all modules [-] - CHARACTER(ChanLen) , DIMENSION(NumModules) :: Module_Abrev !< abbreviation for module (used in file output naming conventions) [-] + TYPE(ProgDesc) , DIMENSION(1:NumModules) :: Module_Ver !< version information from all modules [-] + CHARACTER(ChanLen) , DIMENSION(1:NumModules) :: Module_Abrev !< abbreviation for module (used in file output naming conventions) [-] LOGICAL :: WriteThisStep !< Whether this step will be written in the FAST output files [-] INTEGER(IntKi) :: VTK_count !< Number of VTK files written (for naming output files) [-] INTEGER(IntKi) :: VTK_LastWaveIndx !< last index into wave array [-] @@ -841,14 +841,12 @@ SUBROUTINE FAST_CopyVTK_BLSurfaceType( SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfac ENDIF END SUBROUTINE FAST_CopyVTK_BLSurfaceType - SUBROUTINE FAST_DestroyVTK_BLSurfaceType( VTK_BLSurfaceTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyVTK_BLSurfaceType( VTK_BLSurfaceTypeData, ErrStat, ErrMsg ) TYPE(FAST_VTK_BLSurfaceType), INTENT(INOUT) :: VTK_BLSurfaceTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyVTK_BLSurfaceType' @@ -856,12 +854,6 @@ SUBROUTINE FAST_DestroyVTK_BLSurfaceType( VTK_BLSurfaceTypeData, ErrStat, ErrMsg ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(VTK_BLSurfaceTypeData%AirfoilCoords)) THEN DEALLOCATE(VTK_BLSurfaceTypeData%AirfoilCoords) ENDIF @@ -1111,14 +1103,12 @@ SUBROUTINE FAST_CopyVTK_SurfaceType( SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeD ENDIF END SUBROUTINE FAST_CopyVTK_SurfaceType - SUBROUTINE FAST_DestroyVTK_SurfaceType( VTK_SurfaceTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyVTK_SurfaceType( VTK_SurfaceTypeData, ErrStat, ErrMsg ) TYPE(FAST_VTK_SurfaceType), INTENT(INOUT) :: VTK_SurfaceTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyVTK_SurfaceType' @@ -1126,12 +1116,6 @@ SUBROUTINE FAST_DestroyVTK_SurfaceType( VTK_SurfaceTypeData, ErrStat, ErrMsg, DE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(VTK_SurfaceTypeData%TowerRad)) THEN DEALLOCATE(VTK_SurfaceTypeData%TowerRad) ENDIF @@ -1143,7 +1127,7 @@ SUBROUTINE FAST_DestroyVTK_SurfaceType( VTK_SurfaceTypeData, ErrStat, ErrMsg, DE ENDIF IF (ALLOCATED(VTK_SurfaceTypeData%BladeShape)) THEN DO i1 = LBOUND(VTK_SurfaceTypeData%BladeShape,1), UBOUND(VTK_SurfaceTypeData%BladeShape,1) - CALL FAST_Destroyvtk_blsurfacetype( VTK_SurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyVTK_BLSurfaceType( VTK_SurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(VTK_SurfaceTypeData%BladeShape) @@ -1214,7 +1198,7 @@ SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) Int_BufSz = Int_BufSz + 3 ! BladeShape: size of buffers for each call to pack subtype - CALL FAST_Packvtk_blsurfacetype( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeShape + CALL FAST_PackVTK_BLSurfaceType( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeShape CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1346,7 +1330,7 @@ SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) - CALL FAST_Packvtk_blsurfacetype( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeShape + CALL FAST_PackVTK_BLSurfaceType( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeShape CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1554,7 +1538,7 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackvtk_blsurfacetype( Re_Buf, Db_Buf, Int_Buf, OutData%BladeShape(i1), ErrStat2, ErrMsg2 ) ! BladeShape + CALL FAST_UnpackVTK_BLSurfaceType( Re_Buf, Db_Buf, Int_Buf, OutData%BladeShape(i1), ErrStat2, ErrMsg2 ) ! BladeShape CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1689,14 +1673,12 @@ SUBROUTINE FAST_CopyVTK_ModeShapeType( SrcVTK_ModeShapeTypeData, DstVTK_ModeShap ENDIF END SUBROUTINE FAST_CopyVTK_ModeShapeType - SUBROUTINE FAST_DestroyVTK_ModeShapeType( VTK_ModeShapeTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyVTK_ModeShapeType( VTK_ModeShapeTypeData, ErrStat, ErrMsg ) TYPE(FAST_VTK_ModeShapeType), INTENT(INOUT) :: VTK_ModeShapeTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyVTK_ModeShapeType' @@ -1704,12 +1686,6 @@ SUBROUTINE FAST_DestroyVTK_ModeShapeType( VTK_ModeShapeTypeData, ErrStat, ErrMsg ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(VTK_ModeShapeTypeData%VTKModes)) THEN DEALLOCATE(VTK_ModeShapeTypeData%VTKModes) ENDIF @@ -2251,14 +2227,12 @@ SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%LinInterpOrder = SrcParamData%LinInterpOrder END SUBROUTINE FAST_CopyParam - SUBROUTINE FAST_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyParam' @@ -2266,15 +2240,9 @@ SUBROUTINE FAST_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL FAST_Destroyvtk_surfacetype( ParamData%VTK_surface, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyVTK_SurfaceType( ParamData%VTK_surface, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyvtk_modeshapetype( ParamData%VTK_modes, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyVTK_ModeShapeType( ParamData%VTK_modes, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE FAST_DestroyParam @@ -2390,7 +2358,7 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_BufSz = Db_BufSz + 1 ! VTK_fps ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! VTK_surface: size of buffers for each call to pack subtype - CALL FAST_Packvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface, ErrStat2, ErrMsg2, .TRUE. ) ! VTK_surface + CALL FAST_PackVTK_SurfaceType( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface, ErrStat2, ErrMsg2, .TRUE. ) ! VTK_surface CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2420,7 +2388,7 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 1 ! LinOutJac Int_BufSz = Int_BufSz + 1 ! LinOutMod Int_BufSz = Int_BufSz + 3 ! VTK_modes: size of buffers for each call to pack subtype - CALL FAST_Packvtk_modeshapetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_modes, ErrStat2, ErrMsg2, .TRUE. ) ! VTK_modes + CALL FAST_PackVTK_ModeShapeType( Re_Buf, Db_Buf, Int_Buf, InData%VTK_modes, ErrStat2, ErrMsg2, .TRUE. ) ! VTK_modes CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2661,7 +2629,7 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 1 DbKiBuf(Db_Xferred) = InData%VTK_fps Db_Xferred = Db_Xferred + 1 - CALL FAST_Packvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface, ErrStat2, ErrMsg2, OnlySize ) ! VTK_surface + CALL FAST_PackVTK_SurfaceType( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface, ErrStat2, ErrMsg2, OnlySize ) ! VTK_surface CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2717,7 +2685,7 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%LinOutMod, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - CALL FAST_Packvtk_modeshapetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_modes, ErrStat2, ErrMsg2, OnlySize ) ! VTK_modes + CALL FAST_PackVTK_ModeShapeType( Re_Buf, Db_Buf, Int_Buf, InData%VTK_modes, ErrStat2, ErrMsg2, OnlySize ) ! VTK_modes CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3023,7 +2991,7 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_surface, ErrStat2, ErrMsg2 ) ! VTK_surface + CALL FAST_UnpackVTK_SurfaceType( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_surface, ErrStat2, ErrMsg2 ) ! VTK_surface CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3091,7 +3059,7 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackvtk_modeshapetype( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_modes, ErrStat2, ErrMsg2 ) ! VTK_modes + CALL FAST_UnpackVTK_ModeShapeType( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_modes, ErrStat2, ErrMsg2 ) ! VTK_modes CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4194,14 +4162,12 @@ SUBROUTINE FAST_CopyLinStateSave( SrcLinStateSaveData, DstLinStateSaveData, Ctrl ENDIF END SUBROUTINE FAST_CopyLinStateSave - SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg ) TYPE(FAST_LinStateSave), INTENT(INOUT) :: LinStateSaveData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinStateSave' @@ -4209,16 +4175,10 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(LinStateSaveData%x_IceD)) THEN DO i2 = LBOUND(LinStateSaveData%x_IceD,2), UBOUND(LinStateSaveData%x_IceD,2) DO i1 = LBOUND(LinStateSaveData%x_IceD,1), UBOUND(LinStateSaveData%x_IceD,1) - CALL IceD_DestroyContState( LinStateSaveData%x_IceD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceD_DestroyContState( LinStateSaveData%x_IceD(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -4227,7 +4187,7 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg, DEALLOCA IF (ALLOCATED(LinStateSaveData%xd_IceD)) THEN DO i2 = LBOUND(LinStateSaveData%xd_IceD,2), UBOUND(LinStateSaveData%xd_IceD,2) DO i1 = LBOUND(LinStateSaveData%xd_IceD,1), UBOUND(LinStateSaveData%xd_IceD,1) - CALL IceD_DestroyDiscState( LinStateSaveData%xd_IceD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceD_DestroyDiscState( LinStateSaveData%xd_IceD(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -4236,7 +4196,7 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg, DEALLOCA IF (ALLOCATED(LinStateSaveData%z_IceD)) THEN DO i2 = LBOUND(LinStateSaveData%z_IceD,2), UBOUND(LinStateSaveData%z_IceD,2) DO i1 = LBOUND(LinStateSaveData%z_IceD,1), UBOUND(LinStateSaveData%z_IceD,1) - CALL IceD_DestroyConstrState( LinStateSaveData%z_IceD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceD_DestroyConstrState( LinStateSaveData%z_IceD(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -4245,7 +4205,7 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg, DEALLOCA IF (ALLOCATED(LinStateSaveData%OtherSt_IceD)) THEN DO i2 = LBOUND(LinStateSaveData%OtherSt_IceD,2), UBOUND(LinStateSaveData%OtherSt_IceD,2) DO i1 = LBOUND(LinStateSaveData%OtherSt_IceD,1), UBOUND(LinStateSaveData%OtherSt_IceD,1) - CALL IceD_DestroyOtherState( LinStateSaveData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceD_DestroyOtherState( LinStateSaveData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -4254,7 +4214,7 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg, DEALLOCA IF (ALLOCATED(LinStateSaveData%u_IceD)) THEN DO i2 = LBOUND(LinStateSaveData%u_IceD,2), UBOUND(LinStateSaveData%u_IceD,2) DO i1 = LBOUND(LinStateSaveData%u_IceD,1), UBOUND(LinStateSaveData%u_IceD,1) - CALL IceD_DestroyInput( LinStateSaveData%u_IceD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceD_DestroyInput( LinStateSaveData%u_IceD(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -4263,7 +4223,7 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg, DEALLOCA IF (ALLOCATED(LinStateSaveData%x_BD)) THEN DO i2 = LBOUND(LinStateSaveData%x_BD,2), UBOUND(LinStateSaveData%x_BD,2) DO i1 = LBOUND(LinStateSaveData%x_BD,1), UBOUND(LinStateSaveData%x_BD,1) - CALL BD_DestroyContState( LinStateSaveData%x_BD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyContState( LinStateSaveData%x_BD(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -4272,7 +4232,7 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg, DEALLOCA IF (ALLOCATED(LinStateSaveData%xd_BD)) THEN DO i2 = LBOUND(LinStateSaveData%xd_BD,2), UBOUND(LinStateSaveData%xd_BD,2) DO i1 = LBOUND(LinStateSaveData%xd_BD,1), UBOUND(LinStateSaveData%xd_BD,1) - CALL BD_DestroyDiscState( LinStateSaveData%xd_BD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyDiscState( LinStateSaveData%xd_BD(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -4281,7 +4241,7 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg, DEALLOCA IF (ALLOCATED(LinStateSaveData%z_BD)) THEN DO i2 = LBOUND(LinStateSaveData%z_BD,2), UBOUND(LinStateSaveData%z_BD,2) DO i1 = LBOUND(LinStateSaveData%z_BD,1), UBOUND(LinStateSaveData%z_BD,1) - CALL BD_DestroyConstrState( LinStateSaveData%z_BD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyConstrState( LinStateSaveData%z_BD(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -4290,7 +4250,7 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg, DEALLOCA IF (ALLOCATED(LinStateSaveData%OtherSt_BD)) THEN DO i2 = LBOUND(LinStateSaveData%OtherSt_BD,2), UBOUND(LinStateSaveData%OtherSt_BD,2) DO i1 = LBOUND(LinStateSaveData%OtherSt_BD,1), UBOUND(LinStateSaveData%OtherSt_BD,1) - CALL BD_DestroyOtherState( LinStateSaveData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyOtherState( LinStateSaveData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -4299,7 +4259,7 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg, DEALLOCA IF (ALLOCATED(LinStateSaveData%u_BD)) THEN DO i2 = LBOUND(LinStateSaveData%u_BD,2), UBOUND(LinStateSaveData%u_BD,2) DO i1 = LBOUND(LinStateSaveData%u_BD,1), UBOUND(LinStateSaveData%u_BD,1) - CALL BD_DestroyInput( LinStateSaveData%u_BD(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyInput( LinStateSaveData%u_BD(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -4307,378 +4267,378 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg, DEALLOCA ENDIF IF (ALLOCATED(LinStateSaveData%x_ED)) THEN DO i1 = LBOUND(LinStateSaveData%x_ED,1), UBOUND(LinStateSaveData%x_ED,1) - CALL ED_DestroyContState( LinStateSaveData%x_ED(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyContState( LinStateSaveData%x_ED(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%x_ED) ENDIF IF (ALLOCATED(LinStateSaveData%xd_ED)) THEN DO i1 = LBOUND(LinStateSaveData%xd_ED,1), UBOUND(LinStateSaveData%xd_ED,1) - CALL ED_DestroyDiscState( LinStateSaveData%xd_ED(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyDiscState( LinStateSaveData%xd_ED(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%xd_ED) ENDIF IF (ALLOCATED(LinStateSaveData%z_ED)) THEN DO i1 = LBOUND(LinStateSaveData%z_ED,1), UBOUND(LinStateSaveData%z_ED,1) - CALL ED_DestroyConstrState( LinStateSaveData%z_ED(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyConstrState( LinStateSaveData%z_ED(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%z_ED) ENDIF IF (ALLOCATED(LinStateSaveData%OtherSt_ED)) THEN DO i1 = LBOUND(LinStateSaveData%OtherSt_ED,1), UBOUND(LinStateSaveData%OtherSt_ED,1) - CALL ED_DestroyOtherState( LinStateSaveData%OtherSt_ED(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyOtherState( LinStateSaveData%OtherSt_ED(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%OtherSt_ED) ENDIF IF (ALLOCATED(LinStateSaveData%u_ED)) THEN DO i1 = LBOUND(LinStateSaveData%u_ED,1), UBOUND(LinStateSaveData%u_ED,1) - CALL ED_DestroyInput( LinStateSaveData%u_ED(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyInput( LinStateSaveData%u_ED(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%u_ED) ENDIF IF (ALLOCATED(LinStateSaveData%x_SrvD)) THEN DO i1 = LBOUND(LinStateSaveData%x_SrvD,1), UBOUND(LinStateSaveData%x_SrvD,1) - CALL SrvD_DestroyContState( LinStateSaveData%x_SrvD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyContState( LinStateSaveData%x_SrvD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%x_SrvD) ENDIF IF (ALLOCATED(LinStateSaveData%xd_SrvD)) THEN DO i1 = LBOUND(LinStateSaveData%xd_SrvD,1), UBOUND(LinStateSaveData%xd_SrvD,1) - CALL SrvD_DestroyDiscState( LinStateSaveData%xd_SrvD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyDiscState( LinStateSaveData%xd_SrvD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%xd_SrvD) ENDIF IF (ALLOCATED(LinStateSaveData%z_SrvD)) THEN DO i1 = LBOUND(LinStateSaveData%z_SrvD,1), UBOUND(LinStateSaveData%z_SrvD,1) - CALL SrvD_DestroyConstrState( LinStateSaveData%z_SrvD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyConstrState( LinStateSaveData%z_SrvD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%z_SrvD) ENDIF IF (ALLOCATED(LinStateSaveData%OtherSt_SrvD)) THEN DO i1 = LBOUND(LinStateSaveData%OtherSt_SrvD,1), UBOUND(LinStateSaveData%OtherSt_SrvD,1) - CALL SrvD_DestroyOtherState( LinStateSaveData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyOtherState( LinStateSaveData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%OtherSt_SrvD) ENDIF IF (ALLOCATED(LinStateSaveData%u_SrvD)) THEN DO i1 = LBOUND(LinStateSaveData%u_SrvD,1), UBOUND(LinStateSaveData%u_SrvD,1) - CALL SrvD_DestroyInput( LinStateSaveData%u_SrvD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyInput( LinStateSaveData%u_SrvD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%u_SrvD) ENDIF IF (ALLOCATED(LinStateSaveData%x_AD)) THEN DO i1 = LBOUND(LinStateSaveData%x_AD,1), UBOUND(LinStateSaveData%x_AD,1) - CALL AD_DestroyContState( LinStateSaveData%x_AD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyContState( LinStateSaveData%x_AD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%x_AD) ENDIF IF (ALLOCATED(LinStateSaveData%xd_AD)) THEN DO i1 = LBOUND(LinStateSaveData%xd_AD,1), UBOUND(LinStateSaveData%xd_AD,1) - CALL AD_DestroyDiscState( LinStateSaveData%xd_AD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyDiscState( LinStateSaveData%xd_AD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%xd_AD) ENDIF IF (ALLOCATED(LinStateSaveData%z_AD)) THEN DO i1 = LBOUND(LinStateSaveData%z_AD,1), UBOUND(LinStateSaveData%z_AD,1) - CALL AD_DestroyConstrState( LinStateSaveData%z_AD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyConstrState( LinStateSaveData%z_AD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%z_AD) ENDIF IF (ALLOCATED(LinStateSaveData%OtherSt_AD)) THEN DO i1 = LBOUND(LinStateSaveData%OtherSt_AD,1), UBOUND(LinStateSaveData%OtherSt_AD,1) - CALL AD_DestroyOtherState( LinStateSaveData%OtherSt_AD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyOtherState( LinStateSaveData%OtherSt_AD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%OtherSt_AD) ENDIF IF (ALLOCATED(LinStateSaveData%u_AD)) THEN DO i1 = LBOUND(LinStateSaveData%u_AD,1), UBOUND(LinStateSaveData%u_AD,1) - CALL AD_DestroyInput( LinStateSaveData%u_AD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyInput( LinStateSaveData%u_AD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%u_AD) ENDIF IF (ALLOCATED(LinStateSaveData%x_IfW)) THEN DO i1 = LBOUND(LinStateSaveData%x_IfW,1), UBOUND(LinStateSaveData%x_IfW,1) - CALL InflowWind_DestroyContState( LinStateSaveData%x_IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyContState( LinStateSaveData%x_IfW(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%x_IfW) ENDIF IF (ALLOCATED(LinStateSaveData%xd_IfW)) THEN DO i1 = LBOUND(LinStateSaveData%xd_IfW,1), UBOUND(LinStateSaveData%xd_IfW,1) - CALL InflowWind_DestroyDiscState( LinStateSaveData%xd_IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyDiscState( LinStateSaveData%xd_IfW(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%xd_IfW) ENDIF IF (ALLOCATED(LinStateSaveData%z_IfW)) THEN DO i1 = LBOUND(LinStateSaveData%z_IfW,1), UBOUND(LinStateSaveData%z_IfW,1) - CALL InflowWind_DestroyConstrState( LinStateSaveData%z_IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyConstrState( LinStateSaveData%z_IfW(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%z_IfW) ENDIF IF (ALLOCATED(LinStateSaveData%OtherSt_IfW)) THEN DO i1 = LBOUND(LinStateSaveData%OtherSt_IfW,1), UBOUND(LinStateSaveData%OtherSt_IfW,1) - CALL InflowWind_DestroyOtherState( LinStateSaveData%OtherSt_IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyOtherState( LinStateSaveData%OtherSt_IfW(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%OtherSt_IfW) ENDIF IF (ALLOCATED(LinStateSaveData%u_IfW)) THEN DO i1 = LBOUND(LinStateSaveData%u_IfW,1), UBOUND(LinStateSaveData%u_IfW,1) - CALL InflowWind_DestroyInput( LinStateSaveData%u_IfW(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyInput( LinStateSaveData%u_IfW(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%u_IfW) ENDIF IF (ALLOCATED(LinStateSaveData%x_SD)) THEN DO i1 = LBOUND(LinStateSaveData%x_SD,1), UBOUND(LinStateSaveData%x_SD,1) - CALL SD_DestroyContState( LinStateSaveData%x_SD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyContState( LinStateSaveData%x_SD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%x_SD) ENDIF IF (ALLOCATED(LinStateSaveData%xd_SD)) THEN DO i1 = LBOUND(LinStateSaveData%xd_SD,1), UBOUND(LinStateSaveData%xd_SD,1) - CALL SD_DestroyDiscState( LinStateSaveData%xd_SD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyDiscState( LinStateSaveData%xd_SD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%xd_SD) ENDIF IF (ALLOCATED(LinStateSaveData%z_SD)) THEN DO i1 = LBOUND(LinStateSaveData%z_SD,1), UBOUND(LinStateSaveData%z_SD,1) - CALL SD_DestroyConstrState( LinStateSaveData%z_SD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyConstrState( LinStateSaveData%z_SD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%z_SD) ENDIF IF (ALLOCATED(LinStateSaveData%OtherSt_SD)) THEN DO i1 = LBOUND(LinStateSaveData%OtherSt_SD,1), UBOUND(LinStateSaveData%OtherSt_SD,1) - CALL SD_DestroyOtherState( LinStateSaveData%OtherSt_SD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyOtherState( LinStateSaveData%OtherSt_SD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%OtherSt_SD) ENDIF IF (ALLOCATED(LinStateSaveData%u_SD)) THEN DO i1 = LBOUND(LinStateSaveData%u_SD,1), UBOUND(LinStateSaveData%u_SD,1) - CALL SD_DestroyInput( LinStateSaveData%u_SD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyInput( LinStateSaveData%u_SD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%u_SD) ENDIF IF (ALLOCATED(LinStateSaveData%x_ExtPtfm)) THEN DO i1 = LBOUND(LinStateSaveData%x_ExtPtfm,1), UBOUND(LinStateSaveData%x_ExtPtfm,1) - CALL ExtPtfm_DestroyContState( LinStateSaveData%x_ExtPtfm(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtPtfm_DestroyContState( LinStateSaveData%x_ExtPtfm(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%x_ExtPtfm) ENDIF IF (ALLOCATED(LinStateSaveData%xd_ExtPtfm)) THEN DO i1 = LBOUND(LinStateSaveData%xd_ExtPtfm,1), UBOUND(LinStateSaveData%xd_ExtPtfm,1) - CALL ExtPtfm_DestroyDiscState( LinStateSaveData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtPtfm_DestroyDiscState( LinStateSaveData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%xd_ExtPtfm) ENDIF IF (ALLOCATED(LinStateSaveData%z_ExtPtfm)) THEN DO i1 = LBOUND(LinStateSaveData%z_ExtPtfm,1), UBOUND(LinStateSaveData%z_ExtPtfm,1) - CALL ExtPtfm_DestroyConstrState( LinStateSaveData%z_ExtPtfm(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtPtfm_DestroyConstrState( LinStateSaveData%z_ExtPtfm(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%z_ExtPtfm) ENDIF IF (ALLOCATED(LinStateSaveData%OtherSt_ExtPtfm)) THEN DO i1 = LBOUND(LinStateSaveData%OtherSt_ExtPtfm,1), UBOUND(LinStateSaveData%OtherSt_ExtPtfm,1) - CALL ExtPtfm_DestroyOtherState( LinStateSaveData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtPtfm_DestroyOtherState( LinStateSaveData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%OtherSt_ExtPtfm) ENDIF IF (ALLOCATED(LinStateSaveData%u_ExtPtfm)) THEN DO i1 = LBOUND(LinStateSaveData%u_ExtPtfm,1), UBOUND(LinStateSaveData%u_ExtPtfm,1) - CALL ExtPtfm_DestroyInput( LinStateSaveData%u_ExtPtfm(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtPtfm_DestroyInput( LinStateSaveData%u_ExtPtfm(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%u_ExtPtfm) ENDIF IF (ALLOCATED(LinStateSaveData%x_HD)) THEN DO i1 = LBOUND(LinStateSaveData%x_HD,1), UBOUND(LinStateSaveData%x_HD,1) - CALL HydroDyn_DestroyContState( LinStateSaveData%x_HD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL HydroDyn_DestroyContState( LinStateSaveData%x_HD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%x_HD) ENDIF IF (ALLOCATED(LinStateSaveData%xd_HD)) THEN DO i1 = LBOUND(LinStateSaveData%xd_HD,1), UBOUND(LinStateSaveData%xd_HD,1) - CALL HydroDyn_DestroyDiscState( LinStateSaveData%xd_HD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL HydroDyn_DestroyDiscState( LinStateSaveData%xd_HD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%xd_HD) ENDIF IF (ALLOCATED(LinStateSaveData%z_HD)) THEN DO i1 = LBOUND(LinStateSaveData%z_HD,1), UBOUND(LinStateSaveData%z_HD,1) - CALL HydroDyn_DestroyConstrState( LinStateSaveData%z_HD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL HydroDyn_DestroyConstrState( LinStateSaveData%z_HD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%z_HD) ENDIF IF (ALLOCATED(LinStateSaveData%OtherSt_HD)) THEN DO i1 = LBOUND(LinStateSaveData%OtherSt_HD,1), UBOUND(LinStateSaveData%OtherSt_HD,1) - CALL HydroDyn_DestroyOtherState( LinStateSaveData%OtherSt_HD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL HydroDyn_DestroyOtherState( LinStateSaveData%OtherSt_HD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%OtherSt_HD) ENDIF IF (ALLOCATED(LinStateSaveData%u_HD)) THEN DO i1 = LBOUND(LinStateSaveData%u_HD,1), UBOUND(LinStateSaveData%u_HD,1) - CALL HydroDyn_DestroyInput( LinStateSaveData%u_HD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL HydroDyn_DestroyInput( LinStateSaveData%u_HD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%u_HD) ENDIF IF (ALLOCATED(LinStateSaveData%x_IceF)) THEN DO i1 = LBOUND(LinStateSaveData%x_IceF,1), UBOUND(LinStateSaveData%x_IceF,1) - CALL IceFloe_DestroyContState( LinStateSaveData%x_IceF(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceFloe_DestroyContState( LinStateSaveData%x_IceF(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%x_IceF) ENDIF IF (ALLOCATED(LinStateSaveData%xd_IceF)) THEN DO i1 = LBOUND(LinStateSaveData%xd_IceF,1), UBOUND(LinStateSaveData%xd_IceF,1) - CALL IceFloe_DestroyDiscState( LinStateSaveData%xd_IceF(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceFloe_DestroyDiscState( LinStateSaveData%xd_IceF(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%xd_IceF) ENDIF IF (ALLOCATED(LinStateSaveData%z_IceF)) THEN DO i1 = LBOUND(LinStateSaveData%z_IceF,1), UBOUND(LinStateSaveData%z_IceF,1) - CALL IceFloe_DestroyConstrState( LinStateSaveData%z_IceF(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceFloe_DestroyConstrState( LinStateSaveData%z_IceF(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%z_IceF) ENDIF IF (ALLOCATED(LinStateSaveData%OtherSt_IceF)) THEN DO i1 = LBOUND(LinStateSaveData%OtherSt_IceF,1), UBOUND(LinStateSaveData%OtherSt_IceF,1) - CALL IceFloe_DestroyOtherState( LinStateSaveData%OtherSt_IceF(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceFloe_DestroyOtherState( LinStateSaveData%OtherSt_IceF(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%OtherSt_IceF) ENDIF IF (ALLOCATED(LinStateSaveData%u_IceF)) THEN DO i1 = LBOUND(LinStateSaveData%u_IceF,1), UBOUND(LinStateSaveData%u_IceF,1) - CALL IceFloe_DestroyInput( LinStateSaveData%u_IceF(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceFloe_DestroyInput( LinStateSaveData%u_IceF(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%u_IceF) ENDIF IF (ALLOCATED(LinStateSaveData%x_MAP)) THEN DO i1 = LBOUND(LinStateSaveData%x_MAP,1), UBOUND(LinStateSaveData%x_MAP,1) - CALL MAP_DestroyContState( LinStateSaveData%x_MAP(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_DestroyContState( LinStateSaveData%x_MAP(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%x_MAP) ENDIF IF (ALLOCATED(LinStateSaveData%xd_MAP)) THEN DO i1 = LBOUND(LinStateSaveData%xd_MAP,1), UBOUND(LinStateSaveData%xd_MAP,1) - CALL MAP_DestroyDiscState( LinStateSaveData%xd_MAP(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_DestroyDiscState( LinStateSaveData%xd_MAP(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%xd_MAP) ENDIF IF (ALLOCATED(LinStateSaveData%z_MAP)) THEN DO i1 = LBOUND(LinStateSaveData%z_MAP,1), UBOUND(LinStateSaveData%z_MAP,1) - CALL MAP_DestroyConstrState( LinStateSaveData%z_MAP(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_DestroyConstrState( LinStateSaveData%z_MAP(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%z_MAP) ENDIF IF (ALLOCATED(LinStateSaveData%u_MAP)) THEN DO i1 = LBOUND(LinStateSaveData%u_MAP,1), UBOUND(LinStateSaveData%u_MAP,1) - CALL MAP_DestroyInput( LinStateSaveData%u_MAP(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_DestroyInput( LinStateSaveData%u_MAP(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%u_MAP) ENDIF IF (ALLOCATED(LinStateSaveData%x_FEAM)) THEN DO i1 = LBOUND(LinStateSaveData%x_FEAM,1), UBOUND(LinStateSaveData%x_FEAM,1) - CALL FEAM_DestroyContState( LinStateSaveData%x_FEAM(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FEAM_DestroyContState( LinStateSaveData%x_FEAM(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%x_FEAM) ENDIF IF (ALLOCATED(LinStateSaveData%xd_FEAM)) THEN DO i1 = LBOUND(LinStateSaveData%xd_FEAM,1), UBOUND(LinStateSaveData%xd_FEAM,1) - CALL FEAM_DestroyDiscState( LinStateSaveData%xd_FEAM(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FEAM_DestroyDiscState( LinStateSaveData%xd_FEAM(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%xd_FEAM) ENDIF IF (ALLOCATED(LinStateSaveData%z_FEAM)) THEN DO i1 = LBOUND(LinStateSaveData%z_FEAM,1), UBOUND(LinStateSaveData%z_FEAM,1) - CALL FEAM_DestroyConstrState( LinStateSaveData%z_FEAM(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FEAM_DestroyConstrState( LinStateSaveData%z_FEAM(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%z_FEAM) ENDIF IF (ALLOCATED(LinStateSaveData%OtherSt_FEAM)) THEN DO i1 = LBOUND(LinStateSaveData%OtherSt_FEAM,1), UBOUND(LinStateSaveData%OtherSt_FEAM,1) - CALL FEAM_DestroyOtherState( LinStateSaveData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FEAM_DestroyOtherState( LinStateSaveData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%OtherSt_FEAM) ENDIF IF (ALLOCATED(LinStateSaveData%u_FEAM)) THEN DO i1 = LBOUND(LinStateSaveData%u_FEAM,1), UBOUND(LinStateSaveData%u_FEAM,1) - CALL FEAM_DestroyInput( LinStateSaveData%u_FEAM(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FEAM_DestroyInput( LinStateSaveData%u_FEAM(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%u_FEAM) ENDIF IF (ALLOCATED(LinStateSaveData%x_MD)) THEN DO i1 = LBOUND(LinStateSaveData%x_MD,1), UBOUND(LinStateSaveData%x_MD,1) - CALL MD_DestroyContState( LinStateSaveData%x_MD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyContState( LinStateSaveData%x_MD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%x_MD) ENDIF IF (ALLOCATED(LinStateSaveData%xd_MD)) THEN DO i1 = LBOUND(LinStateSaveData%xd_MD,1), UBOUND(LinStateSaveData%xd_MD,1) - CALL MD_DestroyDiscState( LinStateSaveData%xd_MD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyDiscState( LinStateSaveData%xd_MD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%xd_MD) ENDIF IF (ALLOCATED(LinStateSaveData%z_MD)) THEN DO i1 = LBOUND(LinStateSaveData%z_MD,1), UBOUND(LinStateSaveData%z_MD,1) - CALL MD_DestroyConstrState( LinStateSaveData%z_MD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyConstrState( LinStateSaveData%z_MD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%z_MD) ENDIF IF (ALLOCATED(LinStateSaveData%OtherSt_MD)) THEN DO i1 = LBOUND(LinStateSaveData%OtherSt_MD,1), UBOUND(LinStateSaveData%OtherSt_MD,1) - CALL MD_DestroyOtherState( LinStateSaveData%OtherSt_MD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyOtherState( LinStateSaveData%OtherSt_MD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%OtherSt_MD) ENDIF IF (ALLOCATED(LinStateSaveData%u_MD)) THEN DO i1 = LBOUND(LinStateSaveData%u_MD,1), UBOUND(LinStateSaveData%u_MD,1) - CALL MD_DestroyInput( LinStateSaveData%u_MD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyInput( LinStateSaveData%u_MD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(LinStateSaveData%u_MD) @@ -12951,14 +12911,12 @@ SUBROUTINE FAST_CopyLinType( SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, DstLinTypeData%NumOutputs = SrcLinTypeData%NumOutputs END SUBROUTINE FAST_CopyLinType - SUBROUTINE FAST_DestroyLinType( LinTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyLinType( LinTypeData, ErrStat, ErrMsg ) TYPE(FAST_LinType), INTENT(INOUT) :: LinTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinType' @@ -12966,12 +12924,6 @@ SUBROUTINE FAST_DestroyLinType( LinTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(LinTypeData%Names_u)) THEN DEALLOCATE(LinTypeData%Names_u) ENDIF @@ -14366,14 +14318,12 @@ SUBROUTINE FAST_CopyModLinType( SrcModLinTypeData, DstModLinTypeData, CtrlCode, ENDIF END SUBROUTINE FAST_CopyModLinType - SUBROUTINE FAST_DestroyModLinType( ModLinTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyModLinType( ModLinTypeData, ErrStat, ErrMsg ) TYPE(FAST_ModLinType), INTENT(INOUT) :: ModLinTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModLinType' @@ -14381,15 +14331,9 @@ SUBROUTINE FAST_DestroyModLinType( ModLinTypeData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ModLinTypeData%Instance)) THEN DO i1 = LBOUND(ModLinTypeData%Instance,1), UBOUND(ModLinTypeData%Instance,1) - CALL FAST_Destroylintype( ModLinTypeData%Instance(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyLinType( ModLinTypeData%Instance(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModLinTypeData%Instance) @@ -14437,7 +14381,7 @@ SUBROUTINE FAST_PackModLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%Instance,1), UBOUND(InData%Instance,1) Int_BufSz = Int_BufSz + 3 ! Instance: size of buffers for each call to pack subtype - CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Instance(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Instance + CALL FAST_PackLinType( Re_Buf, Db_Buf, Int_Buf, InData%Instance(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Instance CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14493,7 +14437,7 @@ SUBROUTINE FAST_PackModLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%Instance,1), UBOUND(InData%Instance,1) - CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Instance(i1), ErrStat2, ErrMsg2, OnlySize ) ! Instance + CALL FAST_PackLinType( Re_Buf, Db_Buf, Int_Buf, InData%Instance(i1), ErrStat2, ErrMsg2, OnlySize ) ! Instance CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14599,7 +14543,7 @@ SUBROUTINE FAST_UnPackModLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpacklintype( Re_Buf, Db_Buf, Int_Buf, OutData%Instance(i1), ErrStat2, ErrMsg2 ) ! Instance + CALL FAST_UnpackLinType( Re_Buf, Db_Buf, Int_Buf, OutData%Instance(i1), ErrStat2, ErrMsg2 ) ! Instance CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14638,14 +14582,12 @@ SUBROUTINE FAST_CopyLinFileType( SrcLinFileTypeData, DstLinFileTypeData, CtrlCod DstLinFileTypeData%WindSpeed = SrcLinFileTypeData%WindSpeed END SUBROUTINE FAST_CopyLinFileType - SUBROUTINE FAST_DestroyLinFileType( LinFileTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyLinFileType( LinFileTypeData, ErrStat, ErrMsg ) TYPE(FAST_LinFileType), INTENT(INOUT) :: LinFileTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinFileType' @@ -14653,17 +14595,11 @@ SUBROUTINE FAST_DestroyLinFileType( LinFileTypeData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - DO i1 = LBOUND(LinFileTypeData%Modules,1), UBOUND(LinFileTypeData%Modules,1) - CALL FAST_Destroymodlintype( LinFileTypeData%Modules(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyModLinType( LinFileTypeData%Modules(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL FAST_Destroylintype( LinFileTypeData%Glue, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyLinType( LinFileTypeData%Glue, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE FAST_DestroyLinFileType @@ -14705,7 +14641,7 @@ SUBROUTINE FAST_PackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%Modules,1), UBOUND(InData%Modules,1) Int_BufSz = Int_BufSz + 3 ! Modules: size of buffers for each call to pack subtype - CALL FAST_Packmodlintype( Re_Buf, Db_Buf, Int_Buf, InData%Modules(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Modules + CALL FAST_PackModLinType( Re_Buf, Db_Buf, Int_Buf, InData%Modules(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Modules CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14723,7 +14659,7 @@ SUBROUTINE FAST_PackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END IF END DO Int_BufSz = Int_BufSz + 3 ! Glue: size of buffers for each call to pack subtype - CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Glue, ErrStat2, ErrMsg2, .TRUE. ) ! Glue + CALL FAST_PackLinType( Re_Buf, Db_Buf, Int_Buf, InData%Glue, ErrStat2, ErrMsg2, .TRUE. ) ! Glue CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14770,7 +14706,7 @@ SUBROUTINE FAST_PackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_Xferred = 1 DO i1 = LBOUND(InData%Modules,1), UBOUND(InData%Modules,1) - CALL FAST_Packmodlintype( Re_Buf, Db_Buf, Int_Buf, InData%Modules(i1), ErrStat2, ErrMsg2, OnlySize ) ! Modules + CALL FAST_PackModLinType( Re_Buf, Db_Buf, Int_Buf, InData%Modules(i1), ErrStat2, ErrMsg2, OnlySize ) ! Modules CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14799,7 +14735,7 @@ SUBROUTINE FAST_PackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Glue, ErrStat2, ErrMsg2, OnlySize ) ! Glue + CALL FAST_PackLinType( Re_Buf, Db_Buf, Int_Buf, InData%Glue, ErrStat2, ErrMsg2, OnlySize ) ! Glue CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14898,7 +14834,7 @@ SUBROUTINE FAST_UnPackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackmodlintype( Re_Buf, Db_Buf, Int_Buf, OutData%Modules(i1), ErrStat2, ErrMsg2 ) ! Modules + CALL FAST_UnpackModLinType( Re_Buf, Db_Buf, Int_Buf, OutData%Modules(i1), ErrStat2, ErrMsg2 ) ! Modules CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14939,7 +14875,7 @@ SUBROUTINE FAST_UnPackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpacklintype( Re_Buf, Db_Buf, Int_Buf, OutData%Glue, ErrStat2, ErrMsg2 ) ! Glue + CALL FAST_UnpackLinType( Re_Buf, Db_Buf, Int_Buf, OutData%Glue, ErrStat2, ErrMsg2 ) ! Glue CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15053,14 +14989,12 @@ SUBROUTINE FAST_CopyMiscLinType( SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCod ENDIF END SUBROUTINE FAST_CopyMiscLinType - SUBROUTINE FAST_DestroyMiscLinType( MiscLinTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyMiscLinType( MiscLinTypeData, ErrStat, ErrMsg ) TYPE(FAST_MiscLinType), INTENT(INOUT) :: MiscLinTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMiscLinType' @@ -15068,12 +15002,6 @@ SUBROUTINE FAST_DestroyMiscLinType( MiscLinTypeData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MiscLinTypeData%LinTimes)) THEN DEALLOCATE(MiscLinTypeData%LinTimes) ENDIF @@ -15553,14 +15481,12 @@ SUBROUTINE FAST_CopyOutputFileType( SrcOutputFileTypeData, DstOutputFileTypeData DstOutputFileTypeData%DriverWriteOutput = SrcOutputFileTypeData%DriverWriteOutput END SUBROUTINE FAST_CopyOutputFileType - SUBROUTINE FAST_DestroyOutputFileType( OutputFileTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyOutputFileType( OutputFileTypeData, ErrStat, ErrMsg ) TYPE(FAST_OutputFileType), INTENT(INOUT) :: OutputFileTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOutputFileType' @@ -15568,12 +15494,6 @@ SUBROUTINE FAST_DestroyOutputFileType( OutputFileTypeData, ErrStat, ErrMsg, DEAL ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputFileTypeData%TimeData)) THEN DEALLOCATE(OutputFileTypeData%TimeData) ENDIF @@ -15587,12 +15507,12 @@ SUBROUTINE FAST_DestroyOutputFileType( OutputFileTypeData, ErrStat, ErrMsg, DEAL DEALLOCATE(OutputFileTypeData%ChannelUnits) ENDIF DO i1 = LBOUND(OutputFileTypeData%Module_Ver,1), UBOUND(OutputFileTypeData%Module_Ver,1) - CALL NWTC_Library_Destroyprogdesc( OutputFileTypeData%Module_Ver(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( OutputFileTypeData%Module_Ver(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL FAST_Destroylinfiletype( OutputFileTypeData%Lin, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyLinFileType( OutputFileTypeData%Lin, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroylinstatesave( OutputFileTypeData%op, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyLinStateSave( OutputFileTypeData%op, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE FAST_DestroyOutputFileType @@ -15661,7 +15581,7 @@ SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) Int_BufSz = Int_BufSz + 3 ! Module_Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Module_Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Module_Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15683,7 +15603,7 @@ SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 1 ! VTK_count Int_BufSz = Int_BufSz + 1 ! VTK_LastWaveIndx Int_BufSz = Int_BufSz + 3 ! Lin: size of buffers for each call to pack subtype - CALL FAST_Packlinfiletype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, .TRUE. ) ! Lin + CALL FAST_PackLinFileType( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, .TRUE. ) ! Lin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15701,7 +15621,7 @@ SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF Int_BufSz = Int_BufSz + 1 ! ActualChanLen Int_BufSz = Int_BufSz + 3 ! op: size of buffers for each call to pack subtype - CALL FAST_Packlinstatesave( Re_Buf, Db_Buf, Int_Buf, InData%op, ErrStat2, ErrMsg2, .TRUE. ) ! op + CALL FAST_PackLinStateSave( Re_Buf, Db_Buf, Int_Buf, InData%op, ErrStat2, ErrMsg2, .TRUE. ) ! op CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15835,7 +15755,7 @@ SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END DO END IF DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, OnlySize ) ! Module_Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, OnlySize ) ! Module_Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15876,7 +15796,7 @@ SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%VTK_LastWaveIndx Int_Xferred = Int_Xferred + 1 - CALL FAST_Packlinfiletype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, OnlySize ) ! Lin + CALL FAST_PackLinFileType( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, OnlySize ) ! Lin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15906,7 +15826,7 @@ SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF IntKiBuf(Int_Xferred) = InData%ActualChanLen Int_Xferred = Int_Xferred + 1 - CALL FAST_Packlinstatesave( Re_Buf, Db_Buf, Int_Buf, InData%op, ErrStat2, ErrMsg2, OnlySize ) ! op + CALL FAST_PackLinStateSave( Re_Buf, Db_Buf, Int_Buf, InData%op, ErrStat2, ErrMsg2, OnlySize ) ! op CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -16109,7 +16029,7 @@ SUBROUTINE FAST_UnPackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Module_Ver(i1), ErrStat2, ErrMsg2 ) ! Module_Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Module_Ver(i1), ErrStat2, ErrMsg2 ) ! Module_Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -16164,7 +16084,7 @@ SUBROUTINE FAST_UnPackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpacklinfiletype( Re_Buf, Db_Buf, Int_Buf, OutData%Lin, ErrStat2, ErrMsg2 ) ! Lin + CALL FAST_UnpackLinFileType( Re_Buf, Db_Buf, Int_Buf, OutData%Lin, ErrStat2, ErrMsg2 ) ! Lin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -16206,7 +16126,7 @@ SUBROUTINE FAST_UnPackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpacklinstatesave( Re_Buf, Db_Buf, Int_Buf, OutData%op, ErrStat2, ErrMsg2 ) ! op + CALL FAST_UnpackLinStateSave( Re_Buf, Db_Buf, Int_Buf, OutData%op, ErrStat2, ErrMsg2 ) ! op CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -16417,14 +16337,12 @@ SUBROUTINE FAST_CopyIceDyn_Data( SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCod ENDIF END SUBROUTINE FAST_CopyIceDyn_Data - SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg ) TYPE(IceDyn_Data), INTENT(INOUT) :: IceDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceDyn_Data' @@ -16432,16 +16350,10 @@ SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(IceDyn_DataData%x)) THEN DO i2 = LBOUND(IceDyn_DataData%x,2), UBOUND(IceDyn_DataData%x,2) DO i1 = LBOUND(IceDyn_DataData%x,1), UBOUND(IceDyn_DataData%x,1) - CALL IceD_DestroyContState( IceDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceD_DestroyContState( IceDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -16450,7 +16362,7 @@ SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg, DEALLOCATE IF (ALLOCATED(IceDyn_DataData%xd)) THEN DO i2 = LBOUND(IceDyn_DataData%xd,2), UBOUND(IceDyn_DataData%xd,2) DO i1 = LBOUND(IceDyn_DataData%xd,1), UBOUND(IceDyn_DataData%xd,1) - CALL IceD_DestroyDiscState( IceDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceD_DestroyDiscState( IceDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -16459,7 +16371,7 @@ SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg, DEALLOCATE IF (ALLOCATED(IceDyn_DataData%z)) THEN DO i2 = LBOUND(IceDyn_DataData%z,2), UBOUND(IceDyn_DataData%z,2) DO i1 = LBOUND(IceDyn_DataData%z,1), UBOUND(IceDyn_DataData%z,1) - CALL IceD_DestroyConstrState( IceDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceD_DestroyConstrState( IceDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -16468,7 +16380,7 @@ SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg, DEALLOCATE IF (ALLOCATED(IceDyn_DataData%OtherSt)) THEN DO i2 = LBOUND(IceDyn_DataData%OtherSt,2), UBOUND(IceDyn_DataData%OtherSt,2) DO i1 = LBOUND(IceDyn_DataData%OtherSt,1), UBOUND(IceDyn_DataData%OtherSt,1) - CALL IceD_DestroyOtherState( IceDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceD_DestroyOtherState( IceDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -16476,28 +16388,28 @@ SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg, DEALLOCATE ENDIF IF (ALLOCATED(IceDyn_DataData%p)) THEN DO i1 = LBOUND(IceDyn_DataData%p,1), UBOUND(IceDyn_DataData%p,1) - CALL IceD_DestroyParam( IceDyn_DataData%p(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceD_DestroyParam( IceDyn_DataData%p(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(IceDyn_DataData%p) ENDIF IF (ALLOCATED(IceDyn_DataData%u)) THEN DO i1 = LBOUND(IceDyn_DataData%u,1), UBOUND(IceDyn_DataData%u,1) - CALL IceD_DestroyInput( IceDyn_DataData%u(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceD_DestroyInput( IceDyn_DataData%u(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(IceDyn_DataData%u) ENDIF IF (ALLOCATED(IceDyn_DataData%y)) THEN DO i1 = LBOUND(IceDyn_DataData%y,1), UBOUND(IceDyn_DataData%y,1) - CALL IceD_DestroyOutput( IceDyn_DataData%y(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceD_DestroyOutput( IceDyn_DataData%y(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(IceDyn_DataData%y) ENDIF IF (ALLOCATED(IceDyn_DataData%m)) THEN DO i1 = LBOUND(IceDyn_DataData%m,1), UBOUND(IceDyn_DataData%m,1) - CALL IceD_DestroyMisc( IceDyn_DataData%m(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceD_DestroyMisc( IceDyn_DataData%m(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(IceDyn_DataData%m) @@ -16505,7 +16417,7 @@ SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg, DEALLOCATE IF (ALLOCATED(IceDyn_DataData%Input)) THEN DO i2 = LBOUND(IceDyn_DataData%Input,2), UBOUND(IceDyn_DataData%Input,2) DO i1 = LBOUND(IceDyn_DataData%Input,1), UBOUND(IceDyn_DataData%Input,1) - CALL IceD_DestroyInput( IceDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceD_DestroyInput( IceDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -18031,14 +17943,12 @@ SUBROUTINE FAST_CopyBeamDyn_Data( SrcBeamDyn_DataData, DstBeamDyn_DataData, Ctrl ENDIF END SUBROUTINE FAST_CopyBeamDyn_Data - SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg ) TYPE(BeamDyn_Data), INTENT(INOUT) :: BeamDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyBeamDyn_Data' @@ -18046,16 +17956,10 @@ SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(BeamDyn_DataData%x)) THEN DO i2 = LBOUND(BeamDyn_DataData%x,2), UBOUND(BeamDyn_DataData%x,2) DO i1 = LBOUND(BeamDyn_DataData%x,1), UBOUND(BeamDyn_DataData%x,1) - CALL BD_DestroyContState( BeamDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyContState( BeamDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -18064,7 +17968,7 @@ SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg, DEALLOCA IF (ALLOCATED(BeamDyn_DataData%xd)) THEN DO i2 = LBOUND(BeamDyn_DataData%xd,2), UBOUND(BeamDyn_DataData%xd,2) DO i1 = LBOUND(BeamDyn_DataData%xd,1), UBOUND(BeamDyn_DataData%xd,1) - CALL BD_DestroyDiscState( BeamDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyDiscState( BeamDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -18073,7 +17977,7 @@ SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg, DEALLOCA IF (ALLOCATED(BeamDyn_DataData%z)) THEN DO i2 = LBOUND(BeamDyn_DataData%z,2), UBOUND(BeamDyn_DataData%z,2) DO i1 = LBOUND(BeamDyn_DataData%z,1), UBOUND(BeamDyn_DataData%z,1) - CALL BD_DestroyConstrState( BeamDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyConstrState( BeamDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -18082,7 +17986,7 @@ SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg, DEALLOCA IF (ALLOCATED(BeamDyn_DataData%OtherSt)) THEN DO i2 = LBOUND(BeamDyn_DataData%OtherSt,2), UBOUND(BeamDyn_DataData%OtherSt,2) DO i1 = LBOUND(BeamDyn_DataData%OtherSt,1), UBOUND(BeamDyn_DataData%OtherSt,1) - CALL BD_DestroyOtherState( BeamDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyOtherState( BeamDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -18090,28 +17994,28 @@ SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg, DEALLOCA ENDIF IF (ALLOCATED(BeamDyn_DataData%p)) THEN DO i1 = LBOUND(BeamDyn_DataData%p,1), UBOUND(BeamDyn_DataData%p,1) - CALL BD_DestroyParam( BeamDyn_DataData%p(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyParam( BeamDyn_DataData%p(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(BeamDyn_DataData%p) ENDIF IF (ALLOCATED(BeamDyn_DataData%u)) THEN DO i1 = LBOUND(BeamDyn_DataData%u,1), UBOUND(BeamDyn_DataData%u,1) - CALL BD_DestroyInput( BeamDyn_DataData%u(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyInput( BeamDyn_DataData%u(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(BeamDyn_DataData%u) ENDIF IF (ALLOCATED(BeamDyn_DataData%y)) THEN DO i1 = LBOUND(BeamDyn_DataData%y,1), UBOUND(BeamDyn_DataData%y,1) - CALL BD_DestroyOutput( BeamDyn_DataData%y(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyOutput( BeamDyn_DataData%y(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(BeamDyn_DataData%y) ENDIF IF (ALLOCATED(BeamDyn_DataData%m)) THEN DO i1 = LBOUND(BeamDyn_DataData%m,1), UBOUND(BeamDyn_DataData%m,1) - CALL BD_DestroyMisc( BeamDyn_DataData%m(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyMisc( BeamDyn_DataData%m(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(BeamDyn_DataData%m) @@ -18119,7 +18023,7 @@ SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg, DEALLOCA IF (ALLOCATED(BeamDyn_DataData%Output)) THEN DO i2 = LBOUND(BeamDyn_DataData%Output,2), UBOUND(BeamDyn_DataData%Output,2) DO i1 = LBOUND(BeamDyn_DataData%Output,1), UBOUND(BeamDyn_DataData%Output,1) - CALL BD_DestroyOutput( BeamDyn_DataData%Output(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyOutput( BeamDyn_DataData%Output(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -18127,7 +18031,7 @@ SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg, DEALLOCA ENDIF IF (ALLOCATED(BeamDyn_DataData%y_interp)) THEN DO i1 = LBOUND(BeamDyn_DataData%y_interp,1), UBOUND(BeamDyn_DataData%y_interp,1) - CALL BD_DestroyOutput( BeamDyn_DataData%y_interp(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyOutput( BeamDyn_DataData%y_interp(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(BeamDyn_DataData%y_interp) @@ -18135,7 +18039,7 @@ SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg, DEALLOCA IF (ALLOCATED(BeamDyn_DataData%Input)) THEN DO i2 = LBOUND(BeamDyn_DataData%Input,2), UBOUND(BeamDyn_DataData%Input,2) DO i1 = LBOUND(BeamDyn_DataData%Input,1), UBOUND(BeamDyn_DataData%Input,1) - CALL BD_DestroyInput( BeamDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyInput( BeamDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -19777,14 +19681,12 @@ SUBROUTINE FAST_CopyElastoDyn_Data( SrcElastoDyn_DataData, DstElastoDyn_DataData ENDIF END SUBROUTINE FAST_CopyElastoDyn_Data - SUBROUTINE FAST_DestroyElastoDyn_Data( ElastoDyn_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyElastoDyn_Data( ElastoDyn_DataData, ErrStat, ErrMsg ) TYPE(ElastoDyn_Data), INTENT(INOUT) :: ElastoDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyElastoDyn_Data' @@ -19792,48 +19694,42 @@ SUBROUTINE FAST_DestroyElastoDyn_Data( ElastoDyn_DataData, ErrStat, ErrMsg, DEAL ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - DO i1 = LBOUND(ElastoDyn_DataData%x,1), UBOUND(ElastoDyn_DataData%x,1) - CALL ED_DestroyContState( ElastoDyn_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyContState( ElastoDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(ElastoDyn_DataData%xd,1), UBOUND(ElastoDyn_DataData%xd,1) - CALL ED_DestroyDiscState( ElastoDyn_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyDiscState( ElastoDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(ElastoDyn_DataData%z,1), UBOUND(ElastoDyn_DataData%z,1) - CALL ED_DestroyConstrState( ElastoDyn_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyConstrState( ElastoDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(ElastoDyn_DataData%OtherSt,1), UBOUND(ElastoDyn_DataData%OtherSt,1) - CALL ED_DestroyOtherState( ElastoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyOtherState( ElastoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL ED_DestroyParam( ElastoDyn_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyParam( ElastoDyn_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyInput( ElastoDyn_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyInput( ElastoDyn_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyOutput( ElastoDyn_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyOutput( ElastoDyn_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyMisc( ElastoDyn_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyMisc( ElastoDyn_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(ElastoDyn_DataData%Output)) THEN DO i1 = LBOUND(ElastoDyn_DataData%Output,1), UBOUND(ElastoDyn_DataData%Output,1) - CALL ED_DestroyOutput( ElastoDyn_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyOutput( ElastoDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ElastoDyn_DataData%Output) ENDIF - CALL ED_DestroyOutput( ElastoDyn_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyOutput( ElastoDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(ElastoDyn_DataData%Input)) THEN DO i1 = LBOUND(ElastoDyn_DataData%Input,1), UBOUND(ElastoDyn_DataData%Input,1) - CALL ED_DestroyInput( ElastoDyn_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyInput( ElastoDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ElastoDyn_DataData%Input) @@ -21108,14 +21004,12 @@ SUBROUTINE FAST_CopyServoDyn_Data( SrcServoDyn_DataData, DstServoDyn_DataData, C ENDIF END SUBROUTINE FAST_CopyServoDyn_Data - SUBROUTINE FAST_DestroyServoDyn_Data( ServoDyn_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyServoDyn_Data( ServoDyn_DataData, ErrStat, ErrMsg ) TYPE(ServoDyn_Data), INTENT(INOUT) :: ServoDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyServoDyn_Data' @@ -21123,48 +21017,42 @@ SUBROUTINE FAST_DestroyServoDyn_Data( ServoDyn_DataData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - DO i1 = LBOUND(ServoDyn_DataData%x,1), UBOUND(ServoDyn_DataData%x,1) - CALL SrvD_DestroyContState( ServoDyn_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyContState( ServoDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(ServoDyn_DataData%xd,1), UBOUND(ServoDyn_DataData%xd,1) - CALL SrvD_DestroyDiscState( ServoDyn_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyDiscState( ServoDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(ServoDyn_DataData%z,1), UBOUND(ServoDyn_DataData%z,1) - CALL SrvD_DestroyConstrState( ServoDyn_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyConstrState( ServoDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(ServoDyn_DataData%OtherSt,1), UBOUND(ServoDyn_DataData%OtherSt,1) - CALL SrvD_DestroyOtherState( ServoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyOtherState( ServoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL SrvD_DestroyParam( ServoDyn_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyParam( ServoDyn_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SrvD_DestroyInput( ServoDyn_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyInput( ServoDyn_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SrvD_DestroyOutput( ServoDyn_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyOutput( ServoDyn_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SrvD_DestroyMisc( ServoDyn_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyMisc( ServoDyn_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(ServoDyn_DataData%Output)) THEN DO i1 = LBOUND(ServoDyn_DataData%Output,1), UBOUND(ServoDyn_DataData%Output,1) - CALL SrvD_DestroyOutput( ServoDyn_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyOutput( ServoDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ServoDyn_DataData%Output) ENDIF - CALL SrvD_DestroyOutput( ServoDyn_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyOutput( ServoDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(ServoDyn_DataData%Input)) THEN DO i1 = LBOUND(ServoDyn_DataData%Input,1), UBOUND(ServoDyn_DataData%Input,1) - CALL SrvD_DestroyInput( ServoDyn_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyInput( ServoDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ServoDyn_DataData%Input) @@ -22420,14 +22308,12 @@ SUBROUTINE FAST_CopyAeroDyn14_Data( SrcAeroDyn14_DataData, DstAeroDyn14_DataData ENDIF END SUBROUTINE FAST_CopyAeroDyn14_Data - SUBROUTINE FAST_DestroyAeroDyn14_Data( AeroDyn14_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyAeroDyn14_Data( AeroDyn14_DataData, ErrStat, ErrMsg ) TYPE(AeroDyn14_Data), INTENT(INOUT) :: AeroDyn14_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn14_Data' @@ -22435,39 +22321,33 @@ SUBROUTINE FAST_DestroyAeroDyn14_Data( AeroDyn14_DataData, ErrStat, ErrMsg, DEAL ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - DO i1 = LBOUND(AeroDyn14_DataData%x,1), UBOUND(AeroDyn14_DataData%x,1) - CALL AD14_DestroyContState( AeroDyn14_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyContState( AeroDyn14_DataData%x(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(AeroDyn14_DataData%xd,1), UBOUND(AeroDyn14_DataData%xd,1) - CALL AD14_DestroyDiscState( AeroDyn14_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyDiscState( AeroDyn14_DataData%xd(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(AeroDyn14_DataData%z,1), UBOUND(AeroDyn14_DataData%z,1) - CALL AD14_DestroyConstrState( AeroDyn14_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyConstrState( AeroDyn14_DataData%z(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(AeroDyn14_DataData%OtherSt,1), UBOUND(AeroDyn14_DataData%OtherSt,1) - CALL AD14_DestroyOtherState( AeroDyn14_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyOtherState( AeroDyn14_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL AD14_DestroyParam( AeroDyn14_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyParam( AeroDyn14_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyInput( AeroDyn14_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyInput( AeroDyn14_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyOutput( AeroDyn14_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyOutput( AeroDyn14_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyMisc( AeroDyn14_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyMisc( AeroDyn14_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(AeroDyn14_DataData%Input)) THEN DO i1 = LBOUND(AeroDyn14_DataData%Input,1), UBOUND(AeroDyn14_DataData%Input,1) - CALL AD14_DestroyInput( AeroDyn14_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyInput( AeroDyn14_DataData%Input(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(AeroDyn14_DataData%Input) @@ -23537,14 +23417,12 @@ SUBROUTINE FAST_CopyAeroDyn_Data( SrcAeroDyn_DataData, DstAeroDyn_DataData, Ctrl ENDIF END SUBROUTINE FAST_CopyAeroDyn_Data - SUBROUTINE FAST_DestroyAeroDyn_Data( AeroDyn_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyAeroDyn_Data( AeroDyn_DataData, ErrStat, ErrMsg ) TYPE(AeroDyn_Data), INTENT(INOUT) :: AeroDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn_Data' @@ -23552,48 +23430,42 @@ SUBROUTINE FAST_DestroyAeroDyn_Data( AeroDyn_DataData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - DO i1 = LBOUND(AeroDyn_DataData%x,1), UBOUND(AeroDyn_DataData%x,1) - CALL AD_DestroyContState( AeroDyn_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyContState( AeroDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(AeroDyn_DataData%xd,1), UBOUND(AeroDyn_DataData%xd,1) - CALL AD_DestroyDiscState( AeroDyn_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyDiscState( AeroDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(AeroDyn_DataData%z,1), UBOUND(AeroDyn_DataData%z,1) - CALL AD_DestroyConstrState( AeroDyn_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyConstrState( AeroDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(AeroDyn_DataData%OtherSt,1), UBOUND(AeroDyn_DataData%OtherSt,1) - CALL AD_DestroyOtherState( AeroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyOtherState( AeroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL AD_DestroyParam( AeroDyn_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyParam( AeroDyn_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyInput( AeroDyn_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyInput( AeroDyn_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyOutput( AeroDyn_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyOutput( AeroDyn_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyMisc( AeroDyn_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyMisc( AeroDyn_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(AeroDyn_DataData%Output)) THEN DO i1 = LBOUND(AeroDyn_DataData%Output,1), UBOUND(AeroDyn_DataData%Output,1) - CALL AD_DestroyOutput( AeroDyn_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyOutput( AeroDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(AeroDyn_DataData%Output) ENDIF - CALL AD_DestroyOutput( AeroDyn_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyOutput( AeroDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(AeroDyn_DataData%Input)) THEN DO i1 = LBOUND(AeroDyn_DataData%Input,1), UBOUND(AeroDyn_DataData%Input,1) - CALL AD_DestroyInput( AeroDyn_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyInput( AeroDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(AeroDyn_DataData%Input) @@ -24868,14 +24740,12 @@ SUBROUTINE FAST_CopyInflowWind_Data( SrcInflowWind_DataData, DstInflowWind_DataD ENDIF END SUBROUTINE FAST_CopyInflowWind_Data - SUBROUTINE FAST_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg ) TYPE(InflowWind_Data), INTENT(INOUT) :: InflowWind_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyInflowWind_Data' @@ -24883,48 +24753,42 @@ SUBROUTINE FAST_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg, DE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - DO i1 = LBOUND(InflowWind_DataData%x,1), UBOUND(InflowWind_DataData%x,1) - CALL InflowWind_DestroyContState( InflowWind_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyContState( InflowWind_DataData%x(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(InflowWind_DataData%xd,1), UBOUND(InflowWind_DataData%xd,1) - CALL InflowWind_DestroyDiscState( InflowWind_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyDiscState( InflowWind_DataData%xd(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(InflowWind_DataData%z,1), UBOUND(InflowWind_DataData%z,1) - CALL InflowWind_DestroyConstrState( InflowWind_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyConstrState( InflowWind_DataData%z(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(InflowWind_DataData%OtherSt,1), UBOUND(InflowWind_DataData%OtherSt,1) - CALL InflowWind_DestroyOtherState( InflowWind_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyOtherState( InflowWind_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL InflowWind_DestroyParam( InflowWind_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyParam( InflowWind_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( InflowWind_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyInput( InflowWind_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( InflowWind_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyOutput( InflowWind_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyMisc( InflowWind_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyMisc( InflowWind_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InflowWind_DataData%Output)) THEN DO i1 = LBOUND(InflowWind_DataData%Output,1), UBOUND(InflowWind_DataData%Output,1) - CALL InflowWind_DestroyOutput( InflowWind_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyOutput( InflowWind_DataData%Output(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InflowWind_DataData%Output) ENDIF - CALL InflowWind_DestroyOutput( InflowWind_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyOutput( InflowWind_DataData%y_interp, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InflowWind_DataData%Input)) THEN DO i1 = LBOUND(InflowWind_DataData%Input,1), UBOUND(InflowWind_DataData%Input,1) - CALL InflowWind_DestroyInput( InflowWind_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyInput( InflowWind_DataData%Input(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InflowWind_DataData%Input) @@ -26131,14 +25995,12 @@ SUBROUTINE FAST_CopyOpenFOAM_Data( SrcOpenFOAM_DataData, DstOpenFOAM_DataData, C IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE FAST_CopyOpenFOAM_Data - SUBROUTINE FAST_DestroyOpenFOAM_Data( OpenFOAM_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyOpenFOAM_Data( OpenFOAM_DataData, ErrStat, ErrMsg ) TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpenFOAM_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOpenFOAM_Data' @@ -26146,19 +26008,13 @@ SUBROUTINE FAST_DestroyOpenFOAM_Data( OpenFOAM_DataData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL OpFM_DestroyInput( OpenFOAM_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL OpFM_DestroyInput( OpenFOAM_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyOutput( OpenFOAM_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL OpFM_DestroyOutput( OpenFOAM_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyParam( OpenFOAM_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL OpFM_DestroyParam( OpenFOAM_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyMisc( OpenFOAM_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL OpFM_DestroyMisc( OpenFOAM_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE FAST_DestroyOpenFOAM_Data @@ -26620,14 +26476,12 @@ SUBROUTINE FAST_CopySCDataEx_Data( SrcSCDataEx_DataData, DstSCDataEx_DataData, C IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE FAST_CopySCDataEx_Data - SUBROUTINE FAST_DestroySCDataEx_Data( SCDataEx_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroySCDataEx_Data( SCDataEx_DataData, ErrStat, ErrMsg ) TYPE(SCDataEx_Data), INTENT(INOUT) :: SCDataEx_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySCDataEx_Data' @@ -26635,17 +26489,11 @@ SUBROUTINE FAST_DestroySCDataEx_Data( SCDataEx_DataData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL SC_DX_DestroyInput( SCDataEx_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SC_DX_DestroyInput( SCDataEx_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DX_DestroyOutput( SCDataEx_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SC_DX_DestroyOutput( SCDataEx_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DX_DestroyParam( SCDataEx_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SC_DX_DestroyParam( SCDataEx_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE FAST_DestroySCDataEx_Data @@ -27093,14 +26941,12 @@ SUBROUTINE FAST_CopySubDyn_Data( SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCod ENDIF END SUBROUTINE FAST_CopySubDyn_Data - SUBROUTINE FAST_DestroySubDyn_Data( SubDyn_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroySubDyn_Data( SubDyn_DataData, ErrStat, ErrMsg ) TYPE(SubDyn_Data), INTENT(INOUT) :: SubDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySubDyn_Data' @@ -27108,51 +26954,45 @@ SUBROUTINE FAST_DestroySubDyn_Data( SubDyn_DataData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - DO i1 = LBOUND(SubDyn_DataData%x,1), UBOUND(SubDyn_DataData%x,1) - CALL SD_DestroyContState( SubDyn_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyContState( SubDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(SubDyn_DataData%xd,1), UBOUND(SubDyn_DataData%xd,1) - CALL SD_DestroyDiscState( SubDyn_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyDiscState( SubDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(SubDyn_DataData%z,1), UBOUND(SubDyn_DataData%z,1) - CALL SD_DestroyConstrState( SubDyn_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyConstrState( SubDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(SubDyn_DataData%OtherSt,1), UBOUND(SubDyn_DataData%OtherSt,1) - CALL SD_DestroyOtherState( SubDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyOtherState( SubDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL SD_DestroyParam( SubDyn_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyParam( SubDyn_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyInput( SubDyn_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyInput( SubDyn_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyOutput( SubDyn_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyOutput( SubDyn_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyMisc( SubDyn_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyMisc( SubDyn_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(SubDyn_DataData%Input)) THEN DO i1 = LBOUND(SubDyn_DataData%Input,1), UBOUND(SubDyn_DataData%Input,1) - CALL SD_DestroyInput( SubDyn_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyInput( SubDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(SubDyn_DataData%Input) ENDIF IF (ALLOCATED(SubDyn_DataData%Output)) THEN DO i1 = LBOUND(SubDyn_DataData%Output,1), UBOUND(SubDyn_DataData%Output,1) - CALL SD_DestroyOutput( SubDyn_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyOutput( SubDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(SubDyn_DataData%Output) ENDIF - CALL SD_DestroyOutput( SubDyn_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyOutput( SubDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(SubDyn_DataData%InputTimes)) THEN DEALLOCATE(SubDyn_DataData%InputTimes) @@ -28405,14 +28245,12 @@ SUBROUTINE FAST_CopyExtPtfm_Data( SrcExtPtfm_DataData, DstExtPtfm_DataData, Ctrl ENDIF END SUBROUTINE FAST_CopyExtPtfm_Data - SUBROUTINE FAST_DestroyExtPtfm_Data( ExtPtfm_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyExtPtfm_Data( ExtPtfm_DataData, ErrStat, ErrMsg ) TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExtPtfm_Data' @@ -28420,39 +28258,33 @@ SUBROUTINE FAST_DestroyExtPtfm_Data( ExtPtfm_DataData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - DO i1 = LBOUND(ExtPtfm_DataData%x,1), UBOUND(ExtPtfm_DataData%x,1) - CALL ExtPtfm_DestroyContState( ExtPtfm_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtPtfm_DestroyContState( ExtPtfm_DataData%x(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(ExtPtfm_DataData%xd,1), UBOUND(ExtPtfm_DataData%xd,1) - CALL ExtPtfm_DestroyDiscState( ExtPtfm_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtPtfm_DestroyDiscState( ExtPtfm_DataData%xd(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(ExtPtfm_DataData%z,1), UBOUND(ExtPtfm_DataData%z,1) - CALL ExtPtfm_DestroyConstrState( ExtPtfm_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtPtfm_DestroyConstrState( ExtPtfm_DataData%z(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(ExtPtfm_DataData%OtherSt,1), UBOUND(ExtPtfm_DataData%OtherSt,1) - CALL ExtPtfm_DestroyOtherState( ExtPtfm_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtPtfm_DestroyOtherState( ExtPtfm_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL ExtPtfm_DestroyParam( ExtPtfm_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtPtfm_DestroyParam( ExtPtfm_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyOutput( ExtPtfm_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtPtfm_DestroyOutput( ExtPtfm_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyMisc( ExtPtfm_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtPtfm_DestroyMisc( ExtPtfm_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(ExtPtfm_DataData%Input)) THEN DO i1 = LBOUND(ExtPtfm_DataData%Input,1), UBOUND(ExtPtfm_DataData%Input,1) - CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%Input(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ExtPtfm_DataData%Input) @@ -29522,14 +29354,12 @@ SUBROUTINE FAST_CopySeaState_Data( SrcSeaState_DataData, DstSeaState_DataData, C ENDIF END SUBROUTINE FAST_CopySeaState_Data - SUBROUTINE FAST_DestroySeaState_Data( SeaState_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroySeaState_Data( SeaState_DataData, ErrStat, ErrMsg ) TYPE(SeaState_Data), INTENT(INOUT) :: SeaState_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySeaState_Data' @@ -29537,51 +29367,45 @@ SUBROUTINE FAST_DestroySeaState_Data( SeaState_DataData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - DO i1 = LBOUND(SeaState_DataData%x,1), UBOUND(SeaState_DataData%x,1) - CALL SeaSt_DestroyContState( SeaState_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_DestroyContState( SeaState_DataData%x(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(SeaState_DataData%xd,1), UBOUND(SeaState_DataData%xd,1) - CALL SeaSt_DestroyDiscState( SeaState_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_DestroyDiscState( SeaState_DataData%xd(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(SeaState_DataData%z,1), UBOUND(SeaState_DataData%z,1) - CALL SeaSt_DestroyConstrState( SeaState_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_DestroyConstrState( SeaState_DataData%z(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(SeaState_DataData%OtherSt,1), UBOUND(SeaState_DataData%OtherSt,1) - CALL SeaSt_DestroyOtherState( SeaState_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_DestroyOtherState( SeaState_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL SeaSt_DestroyParam( SeaState_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_DestroyParam( SeaState_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_DestroyInput( SeaState_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_DestroyInput( SeaState_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_DestroyOutput( SeaState_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_DestroyOutput( SeaState_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_DestroyMisc( SeaState_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_DestroyMisc( SeaState_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(SeaState_DataData%Input)) THEN DO i1 = LBOUND(SeaState_DataData%Input,1), UBOUND(SeaState_DataData%Input,1) - CALL SeaSt_DestroyInput( SeaState_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_DestroyInput( SeaState_DataData%Input(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(SeaState_DataData%Input) ENDIF IF (ALLOCATED(SeaState_DataData%Output)) THEN DO i1 = LBOUND(SeaState_DataData%Output,1), UBOUND(SeaState_DataData%Output,1) - CALL SeaSt_DestroyOutput( SeaState_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_DestroyOutput( SeaState_DataData%Output(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(SeaState_DataData%Output) ENDIF - CALL SeaSt_DestroyOutput( SeaState_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_DestroyOutput( SeaState_DataData%y_interp, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(SeaState_DataData%InputTimes)) THEN DEALLOCATE(SeaState_DataData%InputTimes) @@ -30853,14 +30677,12 @@ SUBROUTINE FAST_CopyHydroDyn_Data( SrcHydroDyn_DataData, DstHydroDyn_DataData, C ENDIF END SUBROUTINE FAST_CopyHydroDyn_Data - SUBROUTINE FAST_DestroyHydroDyn_Data( HydroDyn_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyHydroDyn_Data( HydroDyn_DataData, ErrStat, ErrMsg ) TYPE(HydroDyn_Data), INTENT(INOUT) :: HydroDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyHydroDyn_Data' @@ -30868,48 +30690,42 @@ SUBROUTINE FAST_DestroyHydroDyn_Data( HydroDyn_DataData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - DO i1 = LBOUND(HydroDyn_DataData%x,1), UBOUND(HydroDyn_DataData%x,1) - CALL HydroDyn_DestroyContState( HydroDyn_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL HydroDyn_DestroyContState( HydroDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(HydroDyn_DataData%xd,1), UBOUND(HydroDyn_DataData%xd,1) - CALL HydroDyn_DestroyDiscState( HydroDyn_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL HydroDyn_DestroyDiscState( HydroDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(HydroDyn_DataData%z,1), UBOUND(HydroDyn_DataData%z,1) - CALL HydroDyn_DestroyConstrState( HydroDyn_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL HydroDyn_DestroyConstrState( HydroDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(HydroDyn_DataData%OtherSt,1), UBOUND(HydroDyn_DataData%OtherSt,1) - CALL HydroDyn_DestroyOtherState( HydroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL HydroDyn_DestroyOtherState( HydroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL HydroDyn_DestroyParam( HydroDyn_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL HydroDyn_DestroyParam( HydroDyn_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyInput( HydroDyn_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL HydroDyn_DestroyInput( HydroDyn_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyMisc( HydroDyn_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL HydroDyn_DestroyMisc( HydroDyn_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(HydroDyn_DataData%Output)) THEN DO i1 = LBOUND(HydroDyn_DataData%Output,1), UBOUND(HydroDyn_DataData%Output,1) - CALL HydroDyn_DestroyOutput( HydroDyn_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL HydroDyn_DestroyOutput( HydroDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(HydroDyn_DataData%Output) ENDIF - CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(HydroDyn_DataData%Input)) THEN DO i1 = LBOUND(HydroDyn_DataData%Input,1), UBOUND(HydroDyn_DataData%Input,1) - CALL HydroDyn_DestroyInput( HydroDyn_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL HydroDyn_DestroyInput( HydroDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(HydroDyn_DataData%Input) @@ -32165,14 +31981,12 @@ SUBROUTINE FAST_CopyIceFloe_Data( SrcIceFloe_DataData, DstIceFloe_DataData, Ctrl ENDIF END SUBROUTINE FAST_CopyIceFloe_Data - SUBROUTINE FAST_DestroyIceFloe_Data( IceFloe_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyIceFloe_Data( IceFloe_DataData, ErrStat, ErrMsg ) TYPE(IceFloe_Data), INTENT(INOUT) :: IceFloe_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceFloe_Data' @@ -32180,39 +31994,33 @@ SUBROUTINE FAST_DestroyIceFloe_Data( IceFloe_DataData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - DO i1 = LBOUND(IceFloe_DataData%x,1), UBOUND(IceFloe_DataData%x,1) - CALL IceFloe_DestroyContState( IceFloe_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceFloe_DestroyContState( IceFloe_DataData%x(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(IceFloe_DataData%xd,1), UBOUND(IceFloe_DataData%xd,1) - CALL IceFloe_DestroyDiscState( IceFloe_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceFloe_DestroyDiscState( IceFloe_DataData%xd(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(IceFloe_DataData%z,1), UBOUND(IceFloe_DataData%z,1) - CALL IceFloe_DestroyConstrState( IceFloe_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceFloe_DestroyConstrState( IceFloe_DataData%z(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(IceFloe_DataData%OtherSt,1), UBOUND(IceFloe_DataData%OtherSt,1) - CALL IceFloe_DestroyOtherState( IceFloe_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceFloe_DestroyOtherState( IceFloe_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL IceFloe_DestroyParam( IceFloe_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceFloe_DestroyParam( IceFloe_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyInput( IceFloe_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceFloe_DestroyInput( IceFloe_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyOutput( IceFloe_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceFloe_DestroyOutput( IceFloe_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyMisc( IceFloe_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceFloe_DestroyMisc( IceFloe_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(IceFloe_DataData%Input)) THEN DO i1 = LBOUND(IceFloe_DataData%Input,1), UBOUND(IceFloe_DataData%Input,1) - CALL IceFloe_DestroyInput( IceFloe_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceFloe_DestroyInput( IceFloe_DataData%Input(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(IceFloe_DataData%Input) @@ -33280,14 +33088,12 @@ SUBROUTINE FAST_CopyMAP_Data( SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrSta ENDIF END SUBROUTINE FAST_CopyMAP_Data - SUBROUTINE FAST_DestroyMAP_Data( MAP_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyMAP_Data( MAP_DataData, ErrStat, ErrMsg ) TYPE(MAP_Data), INTENT(INOUT) :: MAP_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMAP_Data' @@ -33295,46 +33101,40 @@ SUBROUTINE FAST_DestroyMAP_Data( MAP_DataData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - DO i1 = LBOUND(MAP_DataData%x,1), UBOUND(MAP_DataData%x,1) - CALL MAP_DestroyContState( MAP_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_DestroyContState( MAP_DataData%x(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(MAP_DataData%xd,1), UBOUND(MAP_DataData%xd,1) - CALL MAP_DestroyDiscState( MAP_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_DestroyDiscState( MAP_DataData%xd(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(MAP_DataData%z,1), UBOUND(MAP_DataData%z,1) - CALL MAP_DestroyConstrState( MAP_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_DestroyConstrState( MAP_DataData%z(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL MAP_DestroyOtherState( MAP_DataData%OtherSt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_DestroyOtherState( MAP_DataData%OtherSt, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyParam( MAP_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_DestroyParam( MAP_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyInput( MAP_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_DestroyInput( MAP_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyOutput( MAP_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_DestroyOutput( MAP_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyOtherState( MAP_DataData%OtherSt_old, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_DestroyOtherState( MAP_DataData%OtherSt_old, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MAP_DataData%Output)) THEN DO i1 = LBOUND(MAP_DataData%Output,1), UBOUND(MAP_DataData%Output,1) - CALL MAP_DestroyOutput( MAP_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_DestroyOutput( MAP_DataData%Output(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MAP_DataData%Output) ENDIF - CALL MAP_DestroyOutput( MAP_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_DestroyOutput( MAP_DataData%y_interp, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MAP_DataData%Input)) THEN DO i1 = LBOUND(MAP_DataData%Input,1), UBOUND(MAP_DataData%Input,1) - CALL MAP_DestroyInput( MAP_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_DestroyInput( MAP_DataData%Input(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MAP_DataData%Input) @@ -34582,14 +34382,12 @@ SUBROUTINE FAST_CopyFEAMooring_Data( SrcFEAMooring_DataData, DstFEAMooring_DataD ENDIF END SUBROUTINE FAST_CopyFEAMooring_Data - SUBROUTINE FAST_DestroyFEAMooring_Data( FEAMooring_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyFEAMooring_Data( FEAMooring_DataData, ErrStat, ErrMsg ) TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAMooring_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyFEAMooring_Data' @@ -34597,39 +34395,33 @@ SUBROUTINE FAST_DestroyFEAMooring_Data( FEAMooring_DataData, ErrStat, ErrMsg, DE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - DO i1 = LBOUND(FEAMooring_DataData%x,1), UBOUND(FEAMooring_DataData%x,1) - CALL FEAM_DestroyContState( FEAMooring_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FEAM_DestroyContState( FEAMooring_DataData%x(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(FEAMooring_DataData%xd,1), UBOUND(FEAMooring_DataData%xd,1) - CALL FEAM_DestroyDiscState( FEAMooring_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FEAM_DestroyDiscState( FEAMooring_DataData%xd(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(FEAMooring_DataData%z,1), UBOUND(FEAMooring_DataData%z,1) - CALL FEAM_DestroyConstrState( FEAMooring_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FEAM_DestroyConstrState( FEAMooring_DataData%z(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(FEAMooring_DataData%OtherSt,1), UBOUND(FEAMooring_DataData%OtherSt,1) - CALL FEAM_DestroyOtherState( FEAMooring_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FEAM_DestroyOtherState( FEAMooring_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL FEAM_DestroyParam( FEAMooring_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FEAM_DestroyParam( FEAMooring_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyInput( FEAMooring_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FEAM_DestroyInput( FEAMooring_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyOutput( FEAMooring_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FEAM_DestroyOutput( FEAMooring_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyMisc( FEAMooring_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FEAM_DestroyMisc( FEAMooring_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(FEAMooring_DataData%Input)) THEN DO i1 = LBOUND(FEAMooring_DataData%Input,1), UBOUND(FEAMooring_DataData%Input,1) - CALL FEAM_DestroyInput( FEAMooring_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FEAM_DestroyInput( FEAMooring_DataData%Input(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(FEAMooring_DataData%Input) @@ -35699,14 +35491,12 @@ SUBROUTINE FAST_CopyMoorDyn_Data( SrcMoorDyn_DataData, DstMoorDyn_DataData, Ctrl ENDIF END SUBROUTINE FAST_CopyMoorDyn_Data - SUBROUTINE FAST_DestroyMoorDyn_Data( MoorDyn_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyMoorDyn_Data( MoorDyn_DataData, ErrStat, ErrMsg ) TYPE(MoorDyn_Data), INTENT(INOUT) :: MoorDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMoorDyn_Data' @@ -35714,48 +35504,42 @@ SUBROUTINE FAST_DestroyMoorDyn_Data( MoorDyn_DataData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - DO i1 = LBOUND(MoorDyn_DataData%x,1), UBOUND(MoorDyn_DataData%x,1) - CALL MD_DestroyContState( MoorDyn_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyContState( MoorDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(MoorDyn_DataData%xd,1), UBOUND(MoorDyn_DataData%xd,1) - CALL MD_DestroyDiscState( MoorDyn_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyDiscState( MoorDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(MoorDyn_DataData%z,1), UBOUND(MoorDyn_DataData%z,1) - CALL MD_DestroyConstrState( MoorDyn_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyConstrState( MoorDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(MoorDyn_DataData%OtherSt,1), UBOUND(MoorDyn_DataData%OtherSt,1) - CALL MD_DestroyOtherState( MoorDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyOtherState( MoorDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL MD_DestroyParam( MoorDyn_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyParam( MoorDyn_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyInput( MoorDyn_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyInput( MoorDyn_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyOutput( MoorDyn_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyOutput( MoorDyn_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyMisc( MoorDyn_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyMisc( MoorDyn_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MoorDyn_DataData%Output)) THEN DO i1 = LBOUND(MoorDyn_DataData%Output,1), UBOUND(MoorDyn_DataData%Output,1) - CALL MD_DestroyOutput( MoorDyn_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyOutput( MoorDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MoorDyn_DataData%Output) ENDIF - CALL MD_DestroyOutput( MoorDyn_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyOutput( MoorDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MoorDyn_DataData%Input)) THEN DO i1 = LBOUND(MoorDyn_DataData%Input,1), UBOUND(MoorDyn_DataData%Input,1) - CALL MD_DestroyInput( MoorDyn_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyInput( MoorDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MoorDyn_DataData%Input) @@ -37011,14 +36795,12 @@ SUBROUTINE FAST_CopyOrcaFlex_Data( SrcOrcaFlex_DataData, DstOrcaFlex_DataData, C ENDIF END SUBROUTINE FAST_CopyOrcaFlex_Data - SUBROUTINE FAST_DestroyOrcaFlex_Data( OrcaFlex_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyOrcaFlex_Data( OrcaFlex_DataData, ErrStat, ErrMsg ) TYPE(OrcaFlex_Data), INTENT(INOUT) :: OrcaFlex_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOrcaFlex_Data' @@ -37026,39 +36808,33 @@ SUBROUTINE FAST_DestroyOrcaFlex_Data( OrcaFlex_DataData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - DO i1 = LBOUND(OrcaFlex_DataData%x,1), UBOUND(OrcaFlex_DataData%x,1) - CALL Orca_DestroyContState( OrcaFlex_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Orca_DestroyContState( OrcaFlex_DataData%x(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(OrcaFlex_DataData%xd,1), UBOUND(OrcaFlex_DataData%xd,1) - CALL Orca_DestroyDiscState( OrcaFlex_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Orca_DestroyDiscState( OrcaFlex_DataData%xd(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(OrcaFlex_DataData%z,1), UBOUND(OrcaFlex_DataData%z,1) - CALL Orca_DestroyConstrState( OrcaFlex_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Orca_DestroyConstrState( OrcaFlex_DataData%z(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DO i1 = LBOUND(OrcaFlex_DataData%OtherSt,1), UBOUND(OrcaFlex_DataData%OtherSt,1) - CALL Orca_DestroyOtherState( OrcaFlex_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Orca_DestroyOtherState( OrcaFlex_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL Orca_DestroyParam( OrcaFlex_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Orca_DestroyParam( OrcaFlex_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyInput( OrcaFlex_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Orca_DestroyInput( OrcaFlex_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyOutput( OrcaFlex_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Orca_DestroyOutput( OrcaFlex_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyMisc( OrcaFlex_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Orca_DestroyMisc( OrcaFlex_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(OrcaFlex_DataData%Input)) THEN DO i1 = LBOUND(OrcaFlex_DataData%Input,1), UBOUND(OrcaFlex_DataData%Input,1) - CALL Orca_DestroyInput( OrcaFlex_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Orca_DestroyInput( OrcaFlex_DataData%Input(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OrcaFlex_DataData%Input) @@ -38576,14 +38352,12 @@ SUBROUTINE FAST_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, C IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE FAST_CopyModuleMapType - SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) TYPE(FAST_ModuleMapType), INTENT(INOUT) :: ModuleMapTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModuleMapType' @@ -38591,75 +38365,69 @@ SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ModuleMapTypeData%ED_P_2_BD_P)) THEN DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_BD_P,1), UBOUND(ModuleMapTypeData%ED_P_2_BD_P,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%ED_P_2_BD_P) ENDIF IF (ALLOCATED(ModuleMapTypeData%BD_P_2_ED_P)) THEN DO i1 = LBOUND(ModuleMapTypeData%BD_P_2_ED_P,1), UBOUND(ModuleMapTypeData%BD_P_2_ED_P,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%BD_P_2_ED_P) ENDIF IF (ALLOCATED(ModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_BD_P_Hub,1), UBOUND(ModuleMapTypeData%ED_P_2_BD_P_Hub,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%ED_P_2_BD_P_Hub) ENDIF - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%Structure_2_Mooring, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%Mooring_2_Structure, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_SD_TP, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(ModuleMapTypeData%ED_P_2_NStC_P_N)) THEN DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_NStC_P_N,1), UBOUND(ModuleMapTypeData%ED_P_2_NStC_P_N,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%ED_P_2_NStC_P_N) ENDIF IF (ALLOCATED(ModuleMapTypeData%NStC_P_2_ED_P_N)) THEN DO i1 = LBOUND(ModuleMapTypeData%NStC_P_2_ED_P_N,1), UBOUND(ModuleMapTypeData%NStC_P_2_ED_P_N,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%NStC_P_2_ED_P_N) ENDIF IF (ALLOCATED(ModuleMapTypeData%ED_L_2_TStC_P_T)) THEN DO i1 = LBOUND(ModuleMapTypeData%ED_L_2_TStC_P_T,1), UBOUND(ModuleMapTypeData%ED_L_2_TStC_P_T,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%ED_L_2_TStC_P_T) ENDIF IF (ALLOCATED(ModuleMapTypeData%TStC_P_2_ED_P_T)) THEN DO i1 = LBOUND(ModuleMapTypeData%TStC_P_2_ED_P_T,1), UBOUND(ModuleMapTypeData%TStC_P_2_ED_P_T,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%TStC_P_2_ED_P_T) @@ -38667,7 +38435,7 @@ SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg, DEALLO IF (ALLOCATED(ModuleMapTypeData%ED_L_2_BStC_P_B)) THEN DO i2 = LBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,2), UBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,2) DO i1 = LBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,1), UBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -38676,7 +38444,7 @@ SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg, DEALLO IF (ALLOCATED(ModuleMapTypeData%BStC_P_2_ED_P_B)) THEN DO i2 = LBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,2), UBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,2) DO i1 = LBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,1), UBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -38685,7 +38453,7 @@ SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg, DEALLO IF (ALLOCATED(ModuleMapTypeData%BD_L_2_BStC_P_B)) THEN DO i2 = LBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,2), UBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,2) DO i1 = LBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,1), UBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -38694,7 +38462,7 @@ SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg, DEALLO IF (ALLOCATED(ModuleMapTypeData%BStC_P_2_BD_P_B)) THEN DO i2 = LBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,2), UBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,2) DO i1 = LBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,1), UBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -38702,78 +38470,78 @@ SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg, DEALLO ENDIF IF (ALLOCATED(ModuleMapTypeData%SStC_P_P_2_SubStructure)) THEN DO i1 = LBOUND(ModuleMapTypeData%SStC_P_P_2_SubStructure,1), UBOUND(ModuleMapTypeData%SStC_P_P_2_SubStructure,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%SStC_P_P_2_SubStructure) ENDIF IF (ALLOCATED(ModuleMapTypeData%SubStructure_2_SStC_P_P)) THEN DO i1 = LBOUND(ModuleMapTypeData%SubStructure_2_SStC_P_P,1), UBOUND(ModuleMapTypeData%SubStructure_2_SStC_P_P,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%SubStructure_2_SStC_P_P) ENDIF - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(ModuleMapTypeData%BDED_L_2_AD_L_B)) THEN DO i1 = LBOUND(ModuleMapTypeData%BDED_L_2_AD_L_B,1), UBOUND(ModuleMapTypeData%BDED_L_2_AD_L_B,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%BDED_L_2_AD_L_B) ENDIF IF (ALLOCATED(ModuleMapTypeData%AD_L_2_BDED_B)) THEN DO i1 = LBOUND(ModuleMapTypeData%AD_L_2_BDED_B,1), UBOUND(ModuleMapTypeData%AD_L_2_BDED_B,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%AD_L_2_BDED_B) ENDIF IF (ALLOCATED(ModuleMapTypeData%BD_L_2_BD_L)) THEN DO i1 = LBOUND(ModuleMapTypeData%BD_L_2_BD_L,1), UBOUND(ModuleMapTypeData%BD_L_2_BD_L,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%BD_L_2_BD_L) ENDIF - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(ModuleMapTypeData%ED_P_2_AD_P_R)) THEN DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_AD_P_R,1), UBOUND(ModuleMapTypeData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%ED_P_2_AD_P_R) ENDIF - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(ModuleMapTypeData%IceD_P_2_SD_P)) THEN DO i1 = LBOUND(ModuleMapTypeData%IceD_P_2_SD_P,1), UBOUND(ModuleMapTypeData%IceD_P_2_SD_P,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%IceD_P_2_SD_P) ENDIF IF (ALLOCATED(ModuleMapTypeData%SDy3_P_2_IceD_P)) THEN DO i1 = LBOUND(ModuleMapTypeData%SDy3_P_2_IceD_P,1), UBOUND(ModuleMapTypeData%SDy3_P_2_IceD_P,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%SDy3_P_2_IceD_P) @@ -38886,7 +38654,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%ED_P_2_BD_P,1), UBOUND(InData%ED_P_2_BD_P,1) Int_BufSz = Int_BufSz + 3 ! ED_P_2_BD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_BD_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_BD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -38909,7 +38677,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! BD_P_2_ED_P upper/lower bounds for each dimension DO i1 = LBOUND(InData%BD_P_2_ED_P,1), UBOUND(InData%BD_P_2_ED_P,1) Int_BufSz = Int_BufSz + 3 ! BD_P_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BD_P_2_ED_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BD_P_2_ED_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -38932,7 +38700,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_BD_P_Hub upper/lower bounds for each dimension DO i1 = LBOUND(InData%ED_P_2_BD_P_Hub,1), UBOUND(InData%ED_P_2_BD_P_Hub,1) Int_BufSz = Int_BufSz + 3 ! ED_P_2_BD_P_Hub: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_BD_P_Hub + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_BD_P_Hub CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -38951,7 +38719,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END DO END IF Int_BufSz = Int_BufSz + 3 ! ED_P_2_HD_PRP_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_HD_PRP_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_HD_PRP_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -38968,7 +38736,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! SubStructure_2_HD_W_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2, .TRUE. ) ! SubStructure_2_HD_W_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2, .TRUE. ) ! SubStructure_2_HD_W_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -38985,7 +38753,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! HD_W_P_2_SubStructure: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2, .TRUE. ) ! HD_W_P_2_SubStructure + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2, .TRUE. ) ! HD_W_P_2_SubStructure CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39002,7 +38770,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! SubStructure_2_HD_M_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2, .TRUE. ) ! SubStructure_2_HD_M_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2, .TRUE. ) ! SubStructure_2_HD_M_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39019,7 +38787,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! HD_M_P_2_SubStructure: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_P_2_SubStructure + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_P_2_SubStructure CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39036,7 +38804,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Structure_2_Mooring: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Structure_2_Mooring, ErrStat2, ErrMsg2, .TRUE. ) ! Structure_2_Mooring + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Structure_2_Mooring, ErrStat2, ErrMsg2, .TRUE. ) ! Structure_2_Mooring CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39053,7 +38821,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Mooring_2_Structure: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Mooring_2_Structure, ErrStat2, ErrMsg2, .TRUE. ) ! Mooring_2_Structure + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Mooring_2_Structure, ErrStat2, ErrMsg2, .TRUE. ) ! Mooring_2_Structure CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39070,7 +38838,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! ED_P_2_SD_TP: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SD_TP, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_SD_TP + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SD_TP, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_SD_TP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39087,7 +38855,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! SD_TP_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! SD_TP_2_ED_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! SD_TP_2_ED_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39108,7 +38876,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_NStC_P_N upper/lower bounds for each dimension DO i1 = LBOUND(InData%ED_P_2_NStC_P_N,1), UBOUND(InData%ED_P_2_NStC_P_N,1) Int_BufSz = Int_BufSz + 3 ! ED_P_2_NStC_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_NStC_P_N + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_NStC_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39131,7 +38899,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! NStC_P_2_ED_P_N upper/lower bounds for each dimension DO i1 = LBOUND(InData%NStC_P_2_ED_P_N,1), UBOUND(InData%NStC_P_2_ED_P_N,1) Int_BufSz = Int_BufSz + 3 ! NStC_P_2_ED_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC_P_2_ED_P_N + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC_P_2_ED_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39154,7 +38922,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! ED_L_2_TStC_P_T upper/lower bounds for each dimension DO i1 = LBOUND(InData%ED_L_2_TStC_P_T,1), UBOUND(InData%ED_L_2_TStC_P_T,1) Int_BufSz = Int_BufSz + 3 ! ED_L_2_TStC_P_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_TStC_P_T + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_TStC_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39177,7 +38945,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! TStC_P_2_ED_P_T upper/lower bounds for each dimension DO i1 = LBOUND(InData%TStC_P_2_ED_P_T,1), UBOUND(InData%TStC_P_2_ED_P_T,1) Int_BufSz = Int_BufSz + 3 ! TStC_P_2_ED_P_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC_P_2_ED_P_T + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC_P_2_ED_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39201,7 +38969,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DO i2 = LBOUND(InData%ED_L_2_BStC_P_B,2), UBOUND(InData%ED_L_2_BStC_P_B,2) DO i1 = LBOUND(InData%ED_L_2_BStC_P_B,1), UBOUND(InData%ED_L_2_BStC_P_B,1) Int_BufSz = Int_BufSz + 3 ! ED_L_2_BStC_P_B: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_BStC_P_B + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_BStC_P_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39226,7 +38994,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DO i2 = LBOUND(InData%BStC_P_2_ED_P_B,2), UBOUND(InData%BStC_P_2_ED_P_B,2) DO i1 = LBOUND(InData%BStC_P_2_ED_P_B,1), UBOUND(InData%BStC_P_2_ED_P_B,1) Int_BufSz = Int_BufSz + 3 ! BStC_P_2_ED_P_B: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! BStC_P_2_ED_P_B + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! BStC_P_2_ED_P_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39251,7 +39019,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DO i2 = LBOUND(InData%BD_L_2_BStC_P_B,2), UBOUND(InData%BD_L_2_BStC_P_B,2) DO i1 = LBOUND(InData%BD_L_2_BStC_P_B,1), UBOUND(InData%BD_L_2_BStC_P_B,1) Int_BufSz = Int_BufSz + 3 ! BD_L_2_BStC_P_B: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! BD_L_2_BStC_P_B + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! BD_L_2_BStC_P_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39276,7 +39044,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DO i2 = LBOUND(InData%BStC_P_2_BD_P_B,2), UBOUND(InData%BStC_P_2_BD_P_B,2) DO i1 = LBOUND(InData%BStC_P_2_BD_P_B,1), UBOUND(InData%BStC_P_2_BD_P_B,1) Int_BufSz = Int_BufSz + 3 ! BStC_P_2_BD_P_B: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! BStC_P_2_BD_P_B + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! BStC_P_2_BD_P_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39300,7 +39068,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! SStC_P_P_2_SubStructure upper/lower bounds for each dimension DO i1 = LBOUND(InData%SStC_P_P_2_SubStructure,1), UBOUND(InData%SStC_P_P_2_SubStructure,1) Int_BufSz = Int_BufSz + 3 ! SStC_P_P_2_SubStructure: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC_P_P_2_SubStructure + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC_P_P_2_SubStructure CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39323,7 +39091,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! SubStructure_2_SStC_P_P upper/lower bounds for each dimension DO i1 = LBOUND(InData%SubStructure_2_SStC_P_P,1), UBOUND(InData%SubStructure_2_SStC_P_P,1) Int_BufSz = Int_BufSz + 3 ! SubStructure_2_SStC_P_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SubStructure_2_SStC_P_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SubStructure_2_SStC_P_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39342,7 +39110,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END DO END IF Int_BufSz = Int_BufSz + 3 ! ED_P_2_SrvD_P_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_SrvD_P_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_SrvD_P_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39363,7 +39131,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! BDED_L_2_AD_L_B upper/lower bounds for each dimension DO i1 = LBOUND(InData%BDED_L_2_AD_L_B,1), UBOUND(InData%BDED_L_2_AD_L_B,1) Int_BufSz = Int_BufSz + 3 ! BDED_L_2_AD_L_B: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BDED_L_2_AD_L_B + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BDED_L_2_AD_L_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39386,7 +39154,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! AD_L_2_BDED_B upper/lower bounds for each dimension DO i1 = LBOUND(InData%AD_L_2_BDED_B,1), UBOUND(InData%AD_L_2_BDED_B,1) Int_BufSz = Int_BufSz + 3 ! AD_L_2_BDED_B: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AD_L_2_BDED_B + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AD_L_2_BDED_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39409,7 +39177,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! BD_L_2_BD_L upper/lower bounds for each dimension DO i1 = LBOUND(InData%BD_L_2_BD_L,1), UBOUND(InData%BD_L_2_BD_L,1) Int_BufSz = Int_BufSz + 3 ! BD_L_2_BD_L: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BD_L_2_BD_L + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BD_L_2_BD_L CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39428,7 +39196,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END DO END IF Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_N + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39445,7 +39213,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! AD_P_2_ED_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_ED_P_N + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_ED_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39462,7 +39230,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_TF: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_TF + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_TF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39479,7 +39247,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! AD_P_2_ED_P_TF: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_ED_P_TF + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_ED_P_TF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39496,7 +39264,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! ED_L_2_AD_L_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_AD_L_T + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_AD_L_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39513,7 +39281,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! AD_L_2_ED_P_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! AD_L_2_ED_P_T + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! AD_L_2_ED_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39534,7 +39302,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_AD_P_R upper/lower bounds for each dimension DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_R: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_R + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_R CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39553,7 +39321,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END DO END IF Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_H: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_H + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_H CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39570,7 +39338,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! AD_P_2_ED_P_H: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_ED_P_H + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_ED_P_H CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39587,7 +39355,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! IceF_P_2_SD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! IceF_P_2_SD_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! IceF_P_2_SD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39604,7 +39372,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! SDy3_P_2_IceF_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2, .TRUE. ) ! SDy3_P_2_IceF_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2, .TRUE. ) ! SDy3_P_2_IceF_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39625,7 +39393,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! IceD_P_2_SD_P upper/lower bounds for each dimension DO i1 = LBOUND(InData%IceD_P_2_SD_P,1), UBOUND(InData%IceD_P_2_SD_P,1) Int_BufSz = Int_BufSz + 3 ! IceD_P_2_SD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IceD_P_2_SD_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IceD_P_2_SD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39648,7 +39416,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! SDy3_P_2_IceD_P upper/lower bounds for each dimension DO i1 = LBOUND(InData%SDy3_P_2_IceD_P,1), UBOUND(InData%SDy3_P_2_IceD_P,1) Int_BufSz = Int_BufSz + 3 ! SDy3_P_2_IceD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SDy3_P_2_IceD_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SDy3_P_2_IceD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40049,7 +39817,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%ED_P_2_BD_P,1), UBOUND(InData%ED_P_2_BD_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_BD_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_BD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40090,7 +39858,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%BD_P_2_ED_P,1), UBOUND(InData%BD_P_2_ED_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! BD_P_2_ED_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! BD_P_2_ED_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40131,7 +39899,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%ED_P_2_BD_P_Hub,1), UBOUND(InData%ED_P_2_BD_P_Hub,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_BD_P_Hub + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_BD_P_Hub CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40161,7 +39929,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_HD_PRP_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_HD_PRP_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40189,7 +39957,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2, OnlySize ) ! SubStructure_2_HD_W_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2, OnlySize ) ! SubStructure_2_HD_W_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40217,7 +39985,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2, OnlySize ) ! HD_W_P_2_SubStructure + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2, OnlySize ) ! HD_W_P_2_SubStructure CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40245,7 +40013,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2, OnlySize ) ! SubStructure_2_HD_M_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2, OnlySize ) ! SubStructure_2_HD_M_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40273,7 +40041,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_P_2_SubStructure + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_P_2_SubStructure CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40301,7 +40069,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Structure_2_Mooring, ErrStat2, ErrMsg2, OnlySize ) ! Structure_2_Mooring + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Structure_2_Mooring, ErrStat2, ErrMsg2, OnlySize ) ! Structure_2_Mooring CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40329,7 +40097,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Mooring_2_Structure, ErrStat2, ErrMsg2, OnlySize ) ! Mooring_2_Structure + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Mooring_2_Structure, ErrStat2, ErrMsg2, OnlySize ) ! Mooring_2_Structure CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40357,7 +40125,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SD_TP, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_SD_TP + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SD_TP, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_SD_TP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40385,7 +40153,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! SD_TP_2_ED_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! SD_TP_2_ED_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40424,7 +40192,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%ED_P_2_NStC_P_N,1), UBOUND(InData%ED_P_2_NStC_P_N,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_NStC_P_N + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_NStC_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40465,7 +40233,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%NStC_P_2_ED_P_N,1), UBOUND(InData%NStC_P_2_ED_P_N,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC_P_2_ED_P_N + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC_P_2_ED_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40506,7 +40274,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%ED_L_2_TStC_P_T,1), UBOUND(InData%ED_L_2_TStC_P_T,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_TStC_P_T + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_TStC_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40547,7 +40315,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%TStC_P_2_ED_P_T,1), UBOUND(InData%TStC_P_2_ED_P_T,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC_P_2_ED_P_T + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC_P_2_ED_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40592,7 +40360,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DO i2 = LBOUND(InData%ED_L_2_BStC_P_B,2), UBOUND(InData%ED_L_2_BStC_P_B,2) DO i1 = LBOUND(InData%ED_L_2_BStC_P_B,1), UBOUND(InData%ED_L_2_BStC_P_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_BStC_P_B + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_BStC_P_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40638,7 +40406,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DO i2 = LBOUND(InData%BStC_P_2_ED_P_B,2), UBOUND(InData%BStC_P_2_ED_P_B,2) DO i1 = LBOUND(InData%BStC_P_2_ED_P_B,1), UBOUND(InData%BStC_P_2_ED_P_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BStC_P_2_ED_P_B + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BStC_P_2_ED_P_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40684,7 +40452,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DO i2 = LBOUND(InData%BD_L_2_BStC_P_B,2), UBOUND(InData%BD_L_2_BStC_P_B,2) DO i1 = LBOUND(InData%BD_L_2_BStC_P_B,1), UBOUND(InData%BD_L_2_BStC_P_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BD_L_2_BStC_P_B + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BD_L_2_BStC_P_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40730,7 +40498,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DO i2 = LBOUND(InData%BStC_P_2_BD_P_B,2), UBOUND(InData%BStC_P_2_BD_P_B,2) DO i1 = LBOUND(InData%BStC_P_2_BD_P_B,1), UBOUND(InData%BStC_P_2_BD_P_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BStC_P_2_BD_P_B + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BStC_P_2_BD_P_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40772,7 +40540,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%SStC_P_P_2_SubStructure,1), UBOUND(InData%SStC_P_P_2_SubStructure,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC_P_P_2_SubStructure + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC_P_P_2_SubStructure CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40813,7 +40581,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%SubStructure_2_SStC_P_P,1), UBOUND(InData%SubStructure_2_SStC_P_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! SubStructure_2_SStC_P_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! SubStructure_2_SStC_P_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40843,7 +40611,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_SrvD_P_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_SrvD_P_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40882,7 +40650,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%BDED_L_2_AD_L_B,1), UBOUND(InData%BDED_L_2_AD_L_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! BDED_L_2_AD_L_B + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! BDED_L_2_AD_L_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40923,7 +40691,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%AD_L_2_BDED_B,1), UBOUND(InData%AD_L_2_BDED_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! AD_L_2_BDED_B + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! AD_L_2_BDED_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40964,7 +40732,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%BD_L_2_BD_L,1), UBOUND(InData%BD_L_2_BD_L,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2, OnlySize ) ! BD_L_2_BD_L + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2, OnlySize ) ! BD_L_2_BD_L CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40994,7 +40762,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_N + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -41022,7 +40790,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_ED_P_N + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_ED_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -41050,7 +40818,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_TF + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_TF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -41078,7 +40846,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_ED_P_TF + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_ED_P_TF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -41106,7 +40874,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_AD_L_T + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_AD_L_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -41134,7 +40902,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, OnlySize ) ! AD_L_2_ED_P_T + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, OnlySize ) ! AD_L_2_ED_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -41173,7 +40941,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_R + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_R CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -41203,7 +40971,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_H + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_H CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -41231,7 +40999,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_ED_P_H + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_ED_P_H CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -41259,7 +41027,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! IceF_P_2_SD_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! IceF_P_2_SD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -41287,7 +41055,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2, OnlySize ) ! SDy3_P_2_IceF_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2, OnlySize ) ! SDy3_P_2_IceF_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -41326,7 +41094,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%IceD_P_2_SD_P,1), UBOUND(InData%IceD_P_2_SD_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! IceD_P_2_SD_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! IceD_P_2_SD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -41367,7 +41135,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%SDy3_P_2_IceD_P,1), UBOUND(InData%SDy3_P_2_IceD_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! SDy3_P_2_IceD_P + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! SDy3_P_2_IceD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42085,7 +41853,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_BD_P + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_BD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42141,7 +41909,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2 ) ! BD_P_2_ED_P + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2 ) ! BD_P_2_ED_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42197,7 +41965,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_BD_P_Hub + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_BD_P_Hub CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42239,7 +42007,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_PRP_P + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_PRP_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42279,7 +42047,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2 ) ! SubStructure_2_HD_W_P + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2 ) ! SubStructure_2_HD_W_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42319,7 +42087,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2 ) ! HD_W_P_2_SubStructure + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2 ) ! HD_W_P_2_SubStructure CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42359,7 +42127,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2 ) ! SubStructure_2_HD_M_P + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2 ) ! SubStructure_2_HD_M_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42399,7 +42167,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2 ) ! HD_M_P_2_SubStructure + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2 ) ! HD_M_P_2_SubStructure CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42439,7 +42207,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) ! Structure_2_Mooring + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) ! Structure_2_Mooring CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42479,7 +42247,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) ! Mooring_2_Structure + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) ! Mooring_2_Structure CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42519,7 +42287,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) ! ED_P_2_SD_TP + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) ! ED_P_2_SD_TP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42559,7 +42327,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) ! SD_TP_2_ED_P + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) ! SD_TP_2_ED_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42613,7 +42381,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_NStC_P_N + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_NStC_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42669,7 +42437,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2 ) ! NStC_P_2_ED_P_N + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2 ) ! NStC_P_2_ED_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42725,7 +42493,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2 ) ! ED_L_2_TStC_P_T + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2 ) ! ED_L_2_TStC_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42781,7 +42549,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2 ) ! TStC_P_2_ED_P_T + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2 ) ! TStC_P_2_ED_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42841,7 +42609,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! ED_L_2_BStC_P_B + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! ED_L_2_BStC_P_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42902,7 +42670,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! BStC_P_2_ED_P_B + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! BStC_P_2_ED_P_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42963,7 +42731,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! BD_L_2_BStC_P_B + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! BD_L_2_BStC_P_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43024,7 +42792,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! BStC_P_2_BD_P_B + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! BStC_P_2_BD_P_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43081,7 +42849,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2 ) ! SStC_P_P_2_SubStructure + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2 ) ! SStC_P_P_2_SubStructure CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43137,7 +42905,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2 ) ! SubStructure_2_SStC_P_P + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2 ) ! SubStructure_2_SStC_P_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43179,7 +42947,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2 ) ! ED_P_2_SrvD_P_P + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2 ) ! ED_P_2_SrvD_P_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43233,7 +43001,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) ! BDED_L_2_AD_L_B + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) ! BDED_L_2_AD_L_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43289,7 +43057,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2 ) ! AD_L_2_BDED_B + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2 ) ! AD_L_2_BDED_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43345,7 +43113,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2 ) ! BD_L_2_BD_L + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2 ) ! BD_L_2_BD_L CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43387,7 +43155,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_N + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43427,7 +43195,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) ! AD_P_2_ED_P_N + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) ! AD_P_2_ED_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43467,7 +43235,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_TF + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_TF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43507,7 +43275,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2 ) ! AD_P_2_ED_P_TF + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2 ) ! AD_P_2_ED_P_TF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43547,7 +43315,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) ! ED_L_2_AD_L_T + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) ! ED_L_2_AD_L_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43587,7 +43355,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) ! AD_L_2_ED_P_T + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) ! AD_L_2_ED_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43641,7 +43409,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_R + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_R CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43683,7 +43451,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_H + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_H CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43723,7 +43491,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2 ) ! AD_P_2_ED_P_H + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2 ) ! AD_P_2_ED_P_H CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43763,7 +43531,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) ! IceF_P_2_SD_P + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) ! IceF_P_2_SD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43803,7 +43571,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2 ) ! SDy3_P_2_IceF_P + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2 ) ! SDy3_P_2_IceF_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43857,7 +43625,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2 ) ! IceD_P_2_SD_P + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2 ) ! IceD_P_2_SD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43913,7 +43681,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2 ) ! SDy3_P_2_IceD_P + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2 ) ! SDy3_P_2_IceD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -44799,14 +44567,12 @@ SUBROUTINE FAST_CopyExternInputType( SrcExternInputTypeData, DstExternInputTypeD DstExternInputTypeData%CableDeltaLdot = SrcExternInputTypeData%CableDeltaLdot END SUBROUTINE FAST_CopyExternInputType - SUBROUTINE FAST_DestroyExternInputType( ExternInputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyExternInputType( ExternInputTypeData, ErrStat, ErrMsg ) TYPE(FAST_ExternInputType), INTENT(INOUT) :: ExternInputTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExternInputType' @@ -44814,12 +44580,6 @@ SUBROUTINE FAST_DestroyExternInputType( ExternInputTypeData, ErrStat, ErrMsg, DE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE FAST_DestroyExternInputType SUBROUTINE FAST_PackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -45027,14 +44787,12 @@ SUBROUTINE FAST_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE FAST_CopyMisc - SUBROUTINE FAST_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(FAST_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMisc' @@ -45042,15 +44800,9 @@ SUBROUTINE FAST_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL FAST_Destroyexterninputtype( MiscData%ExternInput, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyExternInputType( MiscData%ExternInput, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroymisclintype( MiscData%Lin, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyMiscLinType( MiscData%Lin, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE FAST_DestroyMisc @@ -45100,7 +44852,7 @@ SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_BufSz = Int_BufSz + 1 ! calcJacobian ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! ExternInput: size of buffers for each call to pack subtype - CALL FAST_Packexterninputtype( Re_Buf, Db_Buf, Int_Buf, InData%ExternInput, ErrStat2, ErrMsg2, .TRUE. ) ! ExternInput + CALL FAST_PackExternInputType( Re_Buf, Db_Buf, Int_Buf, InData%ExternInput, ErrStat2, ErrMsg2, .TRUE. ) ! ExternInput CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -45117,7 +44869,7 @@ SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Lin: size of buffers for each call to pack subtype - CALL FAST_Packmisclintype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, .TRUE. ) ! Lin + CALL FAST_PackMiscLinType( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, .TRUE. ) ! Lin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -45182,7 +44934,7 @@ SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S END DO IntKiBuf(Int_Xferred) = TRANSFER(InData%calcJacobian, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - CALL FAST_Packexterninputtype( Re_Buf, Db_Buf, Int_Buf, InData%ExternInput, ErrStat2, ErrMsg2, OnlySize ) ! ExternInput + CALL FAST_PackExternInputType( Re_Buf, Db_Buf, Int_Buf, InData%ExternInput, ErrStat2, ErrMsg2, OnlySize ) ! ExternInput CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -45210,7 +44962,7 @@ SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packmisclintype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, OnlySize ) ! Lin + CALL FAST_PackMiscLinType( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, OnlySize ) ! Lin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -45326,7 +45078,7 @@ SUBROUTINE FAST_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackexterninputtype( Re_Buf, Db_Buf, Int_Buf, OutData%ExternInput, ErrStat2, ErrMsg2 ) ! ExternInput + CALL FAST_UnpackExternInputType( Re_Buf, Db_Buf, Int_Buf, OutData%ExternInput, ErrStat2, ErrMsg2 ) ! ExternInput CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -45366,7 +45118,7 @@ SUBROUTINE FAST_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackmisclintype( Re_Buf, Db_Buf, Int_Buf, OutData%Lin, ErrStat2, ErrMsg2 ) ! Lin + CALL FAST_UnpackMiscLinType( Re_Buf, Db_Buf, Int_Buf, OutData%Lin, ErrStat2, ErrMsg2 ) ! Lin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -45507,14 +45259,12 @@ SUBROUTINE FAST_CopyInitData( SrcInitDataData, DstInitDataData, CtrlCode, ErrSta IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE FAST_CopyInitData - SUBROUTINE FAST_DestroyInitData( InitDataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyInitData( InitDataData, ErrStat, ErrMsg ) TYPE(FAST_InitData), INTENT(INOUT) :: InitDataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyInitData' @@ -45522,84 +45272,78 @@ SUBROUTINE FAST_DestroyInitData( InitDataData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL ED_DestroyInitInput( InitDataData%InData_ED, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyInitInput( InitDataData%InData_ED, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyInitOutput( InitDataData%OutData_ED, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ED_DestroyInitOutput( InitDataData%OutData_ED, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL BD_DestroyInitInput( InitDataData%InData_BD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyInitInput( InitDataData%InData_BD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitDataData%OutData_BD)) THEN DO i1 = LBOUND(InitDataData%OutData_BD,1), UBOUND(InitDataData%OutData_BD,1) - CALL BD_DestroyInitOutput( InitDataData%OutData_BD(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL BD_DestroyInitOutput( InitDataData%OutData_BD(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(InitDataData%OutData_BD) ENDIF - CALL SrvD_DestroyInitInput( InitDataData%InData_SrvD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyInitInput( InitDataData%InData_SrvD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SrvD_DestroyInitOutput( InitDataData%OutData_SrvD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyInitOutput( InitDataData%OutData_SrvD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyInitInput( InitDataData%InData_AD14, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyInitInput( InitDataData%InData_AD14, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyInitOutput( InitDataData%OutData_AD14, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD14_DestroyInitOutput( InitDataData%OutData_AD14, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyInitInput( InitDataData%InData_AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyInitInput( InitDataData%InData_AD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyInitOutput( InitDataData%OutData_AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL AD_DestroyInitOutput( InitDataData%OutData_AD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInitInput( InitDataData%InData_IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyInitInput( InitDataData%InData_IfW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInitOutput( InitDataData%OutData_IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL InflowWind_DestroyInitOutput( InitDataData%OutData_IfW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyInitInput( InitDataData%InData_OpFM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL OpFM_DestroyInitInput( InitDataData%InData_OpFM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyInitOutput( InitDataData%OutData_OpFM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL OpFM_DestroyInitOutput( InitDataData%OutData_OpFM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_DestroyInitInput( InitDataData%InData_SeaSt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_DestroyInitInput( InitDataData%InData_SeaSt, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_DestroyInitOutput( InitDataData%OutData_SeaSt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_DestroyInitOutput( InitDataData%OutData_SeaSt, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyInitInput( InitDataData%InData_HD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL HydroDyn_DestroyInitInput( InitDataData%InData_HD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyInitOutput( InitDataData%OutData_HD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL HydroDyn_DestroyInitOutput( InitDataData%OutData_HD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyInitInput( InitDataData%InData_SD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyInitInput( InitDataData%InData_SD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyInitOutput( InitDataData%OutData_SD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyInitOutput( InitDataData%OutData_SD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyInitInput( InitDataData%InData_ExtPtfm, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtPtfm_DestroyInitInput( InitDataData%InData_ExtPtfm, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyInitOutput( InitDataData%OutData_ExtPtfm, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtPtfm_DestroyInitOutput( InitDataData%OutData_ExtPtfm, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyInitInput( InitDataData%InData_MAP, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_DestroyInitInput( InitDataData%InData_MAP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyInitOutput( InitDataData%OutData_MAP, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MAP_DestroyInitOutput( InitDataData%OutData_MAP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyInitInput( InitDataData%InData_FEAM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FEAM_DestroyInitInput( InitDataData%InData_FEAM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyInitOutput( InitDataData%OutData_FEAM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FEAM_DestroyInitOutput( InitDataData%OutData_FEAM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyInitInput( InitDataData%InData_MD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyInitInput( InitDataData%InData_MD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyInitOutput( InitDataData%OutData_MD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL MD_DestroyInitOutput( InitDataData%OutData_MD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyInitInput( InitDataData%InData_Orca, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Orca_DestroyInitInput( InitDataData%InData_Orca, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyInitOutput( InitDataData%OutData_Orca, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Orca_DestroyInitOutput( InitDataData%OutData_Orca, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyInitInput( InitDataData%InData_IceF, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceFloe_DestroyInitInput( InitDataData%InData_IceF, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyInitOutput( InitDataData%OutData_IceF, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceFloe_DestroyInitOutput( InitDataData%OutData_IceF, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceD_DestroyInitInput( InitDataData%InData_IceD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceD_DestroyInitInput( InitDataData%InData_IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceD_DestroyInitOutput( InitDataData%OutData_IceD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL IceD_DestroyInitOutput( InitDataData%OutData_IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE FAST_DestroyInitData @@ -48680,14 +48424,12 @@ SUBROUTINE FAST_CopyExternInitType( SrcExternInitTypeData, DstExternInitTypeData DstExternInitTypeData%NodeClusterType = SrcExternInitTypeData%NodeClusterType END SUBROUTINE FAST_CopyExternInitType - SUBROUTINE FAST_DestroyExternInitType( ExternInitTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyExternInitType( ExternInitTypeData, ErrStat, ErrMsg ) TYPE(FAST_ExternInitType), INTENT(INOUT) :: ExternInitTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExternInitType' @@ -48695,12 +48437,6 @@ SUBROUTINE FAST_DestroyExternInitType( ExternInitTypeData, ErrStat, ErrMsg, DEAL ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ExternInitTypeData%fromSCGlob)) THEN DEALLOCATE(ExternInitTypeData%fromSCGlob) ENDIF @@ -49074,14 +48810,12 @@ SUBROUTINE FAST_CopyTurbineType( SrcTurbineTypeData, DstTurbineTypeData, CtrlCod IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE FAST_CopyTurbineType - SUBROUTINE FAST_DestroyTurbineType( TurbineTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE FAST_DestroyTurbineType( TurbineTypeData, ErrStat, ErrMsg ) TYPE(FAST_TurbineType), INTENT(INOUT) :: TurbineTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyTurbineType' @@ -49089,55 +48823,49 @@ SUBROUTINE FAST_DestroyTurbineType( TurbineTypeData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL FAST_DestroyParam( TurbineTypeData%p_FAST, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyParam( TurbineTypeData%p_FAST, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyoutputfiletype( TurbineTypeData%y_FAST, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyOutputFileType( TurbineTypeData%y_FAST, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyMisc( TurbineTypeData%m_FAST, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyMisc( TurbineTypeData%m_FAST, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroymodulemaptype( TurbineTypeData%MeshMapData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyModuleMapType( TurbineTypeData%MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyelastodyn_data( TurbineTypeData%ED, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyElastoDyn_Data( TurbineTypeData%ED, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroybeamdyn_data( TurbineTypeData%BD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyBeamDyn_Data( TurbineTypeData%BD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyservodyn_data( TurbineTypeData%SrvD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyServoDyn_Data( TurbineTypeData%SrvD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyaerodyn_data( TurbineTypeData%AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyAeroDyn_Data( TurbineTypeData%AD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyaerodyn14_data( TurbineTypeData%AD14, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyAeroDyn14_Data( TurbineTypeData%AD14, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyinflowwind_data( TurbineTypeData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyInflowWind_Data( TurbineTypeData%IfW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyopenfoam_data( TurbineTypeData%OpFM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyOpenFOAM_Data( TurbineTypeData%OpFM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyscdataex_data( TurbineTypeData%SC_DX, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroySCDataEx_Data( TurbineTypeData%SC_DX, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyseastate_data( TurbineTypeData%SeaSt, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroySeaState_Data( TurbineTypeData%SeaSt, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyhydrodyn_data( TurbineTypeData%HD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyHydroDyn_Data( TurbineTypeData%HD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroysubdyn_data( TurbineTypeData%SD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroySubDyn_Data( TurbineTypeData%SD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroymap_data( TurbineTypeData%MAP, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyMAP_Data( TurbineTypeData%MAP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyfeamooring_data( TurbineTypeData%FEAM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyFEAMooring_Data( TurbineTypeData%FEAM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroymoordyn_data( TurbineTypeData%MD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyMoorDyn_Data( TurbineTypeData%MD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyorcaflex_data( TurbineTypeData%Orca, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyOrcaFlex_Data( TurbineTypeData%Orca, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyicefloe_data( TurbineTypeData%IceF, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyIceFloe_Data( TurbineTypeData%IceF, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyicedyn_data( TurbineTypeData%IceD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyIceDyn_Data( TurbineTypeData%IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_Destroyextptfm_data( TurbineTypeData%ExtPtfm, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL FAST_DestroyExtPtfm_Data( TurbineTypeData%ExtPtfm, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE FAST_DestroyTurbineType @@ -49196,7 +48924,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! y_FAST: size of buffers for each call to pack subtype - CALL FAST_Packoutputfiletype( Re_Buf, Db_Buf, Int_Buf, InData%y_FAST, ErrStat2, ErrMsg2, .TRUE. ) ! y_FAST + CALL FAST_PackOutputFileType( Re_Buf, Db_Buf, Int_Buf, InData%y_FAST, ErrStat2, ErrMsg2, .TRUE. ) ! y_FAST CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49230,7 +48958,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! MeshMapData: size of buffers for each call to pack subtype - CALL FAST_Packmodulemaptype( Re_Buf, Db_Buf, Int_Buf, InData%MeshMapData, ErrStat2, ErrMsg2, .TRUE. ) ! MeshMapData + CALL FAST_PackModuleMapType( Re_Buf, Db_Buf, Int_Buf, InData%MeshMapData, ErrStat2, ErrMsg2, .TRUE. ) ! MeshMapData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49247,7 +48975,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! ED: size of buffers for each call to pack subtype - CALL FAST_Packelastodyn_data( Re_Buf, Db_Buf, Int_Buf, InData%ED, ErrStat2, ErrMsg2, .TRUE. ) ! ED + CALL FAST_PackElastoDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%ED, ErrStat2, ErrMsg2, .TRUE. ) ! ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49264,7 +48992,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! BD: size of buffers for each call to pack subtype - CALL FAST_Packbeamdyn_data( Re_Buf, Db_Buf, Int_Buf, InData%BD, ErrStat2, ErrMsg2, .TRUE. ) ! BD + CALL FAST_PackBeamDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%BD, ErrStat2, ErrMsg2, .TRUE. ) ! BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49281,7 +49009,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! SrvD: size of buffers for each call to pack subtype - CALL FAST_Packservodyn_data( Re_Buf, Db_Buf, Int_Buf, InData%SrvD, ErrStat2, ErrMsg2, .TRUE. ) ! SrvD + CALL FAST_PackServoDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%SrvD, ErrStat2, ErrMsg2, .TRUE. ) ! SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49298,7 +49026,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL FAST_Packaerodyn_data( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD + CALL FAST_PackAeroDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49315,7 +49043,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! AD14: size of buffers for each call to pack subtype - CALL FAST_Packaerodyn14_data( Re_Buf, Db_Buf, Int_Buf, InData%AD14, ErrStat2, ErrMsg2, .TRUE. ) ! AD14 + CALL FAST_PackAeroDyn14_Data( Re_Buf, Db_Buf, Int_Buf, InData%AD14, ErrStat2, ErrMsg2, .TRUE. ) ! AD14 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49332,7 +49060,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL FAST_Packinflowwind_data( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW + CALL FAST_PackInflowWind_Data( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49349,7 +49077,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! OpFM: size of buffers for each call to pack subtype - CALL FAST_Packopenfoam_data( Re_Buf, Db_Buf, Int_Buf, InData%OpFM, ErrStat2, ErrMsg2, .TRUE. ) ! OpFM + CALL FAST_PackOpenFOAM_Data( Re_Buf, Db_Buf, Int_Buf, InData%OpFM, ErrStat2, ErrMsg2, .TRUE. ) ! OpFM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49366,7 +49094,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! SC_DX: size of buffers for each call to pack subtype - CALL FAST_Packscdataex_data( Re_Buf, Db_Buf, Int_Buf, InData%SC_DX, ErrStat2, ErrMsg2, .TRUE. ) ! SC_DX + CALL FAST_PackSCDataEx_Data( Re_Buf, Db_Buf, Int_Buf, InData%SC_DX, ErrStat2, ErrMsg2, .TRUE. ) ! SC_DX CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49383,7 +49111,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! SeaSt: size of buffers for each call to pack subtype - CALL FAST_Packseastate_data( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt + CALL FAST_PackSeaState_Data( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49400,7 +49128,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! HD: size of buffers for each call to pack subtype - CALL FAST_Packhydrodyn_data( Re_Buf, Db_Buf, Int_Buf, InData%HD, ErrStat2, ErrMsg2, .TRUE. ) ! HD + CALL FAST_PackHydroDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%HD, ErrStat2, ErrMsg2, .TRUE. ) ! HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49417,7 +49145,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! SD: size of buffers for each call to pack subtype - CALL FAST_Packsubdyn_data( Re_Buf, Db_Buf, Int_Buf, InData%SD, ErrStat2, ErrMsg2, .TRUE. ) ! SD + CALL FAST_PackSubDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%SD, ErrStat2, ErrMsg2, .TRUE. ) ! SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49434,7 +49162,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! MAP: size of buffers for each call to pack subtype - CALL FAST_Packmap_data( Re_Buf, Db_Buf, Int_Buf, InData%MAP, ErrStat2, ErrMsg2, .TRUE. ) ! MAP + CALL FAST_PackMAP_Data( Re_Buf, Db_Buf, Int_Buf, InData%MAP, ErrStat2, ErrMsg2, .TRUE. ) ! MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49451,7 +49179,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! FEAM: size of buffers for each call to pack subtype - CALL FAST_Packfeamooring_data( Re_Buf, Db_Buf, Int_Buf, InData%FEAM, ErrStat2, ErrMsg2, .TRUE. ) ! FEAM + CALL FAST_PackFEAMooring_Data( Re_Buf, Db_Buf, Int_Buf, InData%FEAM, ErrStat2, ErrMsg2, .TRUE. ) ! FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49468,7 +49196,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! MD: size of buffers for each call to pack subtype - CALL FAST_Packmoordyn_data( Re_Buf, Db_Buf, Int_Buf, InData%MD, ErrStat2, ErrMsg2, .TRUE. ) ! MD + CALL FAST_PackMoorDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%MD, ErrStat2, ErrMsg2, .TRUE. ) ! MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49485,7 +49213,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! Orca: size of buffers for each call to pack subtype - CALL FAST_Packorcaflex_data( Re_Buf, Db_Buf, Int_Buf, InData%Orca, ErrStat2, ErrMsg2, .TRUE. ) ! Orca + CALL FAST_PackOrcaFlex_Data( Re_Buf, Db_Buf, Int_Buf, InData%Orca, ErrStat2, ErrMsg2, .TRUE. ) ! Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49502,7 +49230,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! IceF: size of buffers for each call to pack subtype - CALL FAST_Packicefloe_data( Re_Buf, Db_Buf, Int_Buf, InData%IceF, ErrStat2, ErrMsg2, .TRUE. ) ! IceF + CALL FAST_PackIceFloe_Data( Re_Buf, Db_Buf, Int_Buf, InData%IceF, ErrStat2, ErrMsg2, .TRUE. ) ! IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49519,7 +49247,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! IceD: size of buffers for each call to pack subtype - CALL FAST_Packicedyn_data( Re_Buf, Db_Buf, Int_Buf, InData%IceD, ErrStat2, ErrMsg2, .TRUE. ) ! IceD + CALL FAST_PackIceDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%IceD, ErrStat2, ErrMsg2, .TRUE. ) ! IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49536,7 +49264,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! ExtPtfm: size of buffers for each call to pack subtype - CALL FAST_Packextptfm_data( Re_Buf, Db_Buf, Int_Buf, InData%ExtPtfm, ErrStat2, ErrMsg2, .TRUE. ) ! ExtPtfm + CALL FAST_PackExtPtfm_Data( Re_Buf, Db_Buf, Int_Buf, InData%ExtPtfm, ErrStat2, ErrMsg2, .TRUE. ) ! ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49609,7 +49337,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packoutputfiletype( Re_Buf, Db_Buf, Int_Buf, InData%y_FAST, ErrStat2, ErrMsg2, OnlySize ) ! y_FAST + CALL FAST_PackOutputFileType( Re_Buf, Db_Buf, Int_Buf, InData%y_FAST, ErrStat2, ErrMsg2, OnlySize ) ! y_FAST CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49665,7 +49393,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packmodulemaptype( Re_Buf, Db_Buf, Int_Buf, InData%MeshMapData, ErrStat2, ErrMsg2, OnlySize ) ! MeshMapData + CALL FAST_PackModuleMapType( Re_Buf, Db_Buf, Int_Buf, InData%MeshMapData, ErrStat2, ErrMsg2, OnlySize ) ! MeshMapData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49693,7 +49421,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packelastodyn_data( Re_Buf, Db_Buf, Int_Buf, InData%ED, ErrStat2, ErrMsg2, OnlySize ) ! ED + CALL FAST_PackElastoDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%ED, ErrStat2, ErrMsg2, OnlySize ) ! ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49721,7 +49449,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packbeamdyn_data( Re_Buf, Db_Buf, Int_Buf, InData%BD, ErrStat2, ErrMsg2, OnlySize ) ! BD + CALL FAST_PackBeamDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%BD, ErrStat2, ErrMsg2, OnlySize ) ! BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49749,7 +49477,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packservodyn_data( Re_Buf, Db_Buf, Int_Buf, InData%SrvD, ErrStat2, ErrMsg2, OnlySize ) ! SrvD + CALL FAST_PackServoDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%SrvD, ErrStat2, ErrMsg2, OnlySize ) ! SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49777,7 +49505,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packaerodyn_data( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD + CALL FAST_PackAeroDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49805,7 +49533,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packaerodyn14_data( Re_Buf, Db_Buf, Int_Buf, InData%AD14, ErrStat2, ErrMsg2, OnlySize ) ! AD14 + CALL FAST_PackAeroDyn14_Data( Re_Buf, Db_Buf, Int_Buf, InData%AD14, ErrStat2, ErrMsg2, OnlySize ) ! AD14 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49833,7 +49561,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packinflowwind_data( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW + CALL FAST_PackInflowWind_Data( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49861,7 +49589,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packopenfoam_data( Re_Buf, Db_Buf, Int_Buf, InData%OpFM, ErrStat2, ErrMsg2, OnlySize ) ! OpFM + CALL FAST_PackOpenFOAM_Data( Re_Buf, Db_Buf, Int_Buf, InData%OpFM, ErrStat2, ErrMsg2, OnlySize ) ! OpFM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49889,7 +49617,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packscdataex_data( Re_Buf, Db_Buf, Int_Buf, InData%SC_DX, ErrStat2, ErrMsg2, OnlySize ) ! SC_DX + CALL FAST_PackSCDataEx_Data( Re_Buf, Db_Buf, Int_Buf, InData%SC_DX, ErrStat2, ErrMsg2, OnlySize ) ! SC_DX CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49917,7 +49645,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packseastate_data( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt + CALL FAST_PackSeaState_Data( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49945,7 +49673,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packhydrodyn_data( Re_Buf, Db_Buf, Int_Buf, InData%HD, ErrStat2, ErrMsg2, OnlySize ) ! HD + CALL FAST_PackHydroDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%HD, ErrStat2, ErrMsg2, OnlySize ) ! HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -49973,7 +49701,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packsubdyn_data( Re_Buf, Db_Buf, Int_Buf, InData%SD, ErrStat2, ErrMsg2, OnlySize ) ! SD + CALL FAST_PackSubDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%SD, ErrStat2, ErrMsg2, OnlySize ) ! SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50001,7 +49729,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packmap_data( Re_Buf, Db_Buf, Int_Buf, InData%MAP, ErrStat2, ErrMsg2, OnlySize ) ! MAP + CALL FAST_PackMAP_Data( Re_Buf, Db_Buf, Int_Buf, InData%MAP, ErrStat2, ErrMsg2, OnlySize ) ! MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50029,7 +49757,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packfeamooring_data( Re_Buf, Db_Buf, Int_Buf, InData%FEAM, ErrStat2, ErrMsg2, OnlySize ) ! FEAM + CALL FAST_PackFEAMooring_Data( Re_Buf, Db_Buf, Int_Buf, InData%FEAM, ErrStat2, ErrMsg2, OnlySize ) ! FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50057,7 +49785,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packmoordyn_data( Re_Buf, Db_Buf, Int_Buf, InData%MD, ErrStat2, ErrMsg2, OnlySize ) ! MD + CALL FAST_PackMoorDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%MD, ErrStat2, ErrMsg2, OnlySize ) ! MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50085,7 +49813,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packorcaflex_data( Re_Buf, Db_Buf, Int_Buf, InData%Orca, ErrStat2, ErrMsg2, OnlySize ) ! Orca + CALL FAST_PackOrcaFlex_Data( Re_Buf, Db_Buf, Int_Buf, InData%Orca, ErrStat2, ErrMsg2, OnlySize ) ! Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50113,7 +49841,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packicefloe_data( Re_Buf, Db_Buf, Int_Buf, InData%IceF, ErrStat2, ErrMsg2, OnlySize ) ! IceF + CALL FAST_PackIceFloe_Data( Re_Buf, Db_Buf, Int_Buf, InData%IceF, ErrStat2, ErrMsg2, OnlySize ) ! IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50141,7 +49869,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packicedyn_data( Re_Buf, Db_Buf, Int_Buf, InData%IceD, ErrStat2, ErrMsg2, OnlySize ) ! IceD + CALL FAST_PackIceDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%IceD, ErrStat2, ErrMsg2, OnlySize ) ! IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50169,7 +49897,7 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FAST_Packextptfm_data( Re_Buf, Db_Buf, Int_Buf, InData%ExtPtfm, ErrStat2, ErrMsg2, OnlySize ) ! ExtPtfm + CALL FAST_PackExtPtfm_Data( Re_Buf, Db_Buf, Int_Buf, InData%ExtPtfm, ErrStat2, ErrMsg2, OnlySize ) ! ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50300,7 +50028,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackoutputfiletype( Re_Buf, Db_Buf, Int_Buf, OutData%y_FAST, ErrStat2, ErrMsg2 ) ! y_FAST + CALL FAST_UnpackOutputFileType( Re_Buf, Db_Buf, Int_Buf, OutData%y_FAST, ErrStat2, ErrMsg2 ) ! y_FAST CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50380,7 +50108,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackmodulemaptype( Re_Buf, Db_Buf, Int_Buf, OutData%MeshMapData, ErrStat2, ErrMsg2 ) ! MeshMapData + CALL FAST_UnpackModuleMapType( Re_Buf, Db_Buf, Int_Buf, OutData%MeshMapData, ErrStat2, ErrMsg2 ) ! MeshMapData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50420,7 +50148,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackelastodyn_data( Re_Buf, Db_Buf, Int_Buf, OutData%ED, ErrStat2, ErrMsg2 ) ! ED + CALL FAST_UnpackElastoDyn_Data( Re_Buf, Db_Buf, Int_Buf, OutData%ED, ErrStat2, ErrMsg2 ) ! ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50460,7 +50188,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackbeamdyn_data( Re_Buf, Db_Buf, Int_Buf, OutData%BD, ErrStat2, ErrMsg2 ) ! BD + CALL FAST_UnpackBeamDyn_Data( Re_Buf, Db_Buf, Int_Buf, OutData%BD, ErrStat2, ErrMsg2 ) ! BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50500,7 +50228,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackservodyn_data( Re_Buf, Db_Buf, Int_Buf, OutData%SrvD, ErrStat2, ErrMsg2 ) ! SrvD + CALL FAST_UnpackServoDyn_Data( Re_Buf, Db_Buf, Int_Buf, OutData%SrvD, ErrStat2, ErrMsg2 ) ! SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50540,7 +50268,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackaerodyn_data( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD + CALL FAST_UnpackAeroDyn_Data( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50580,7 +50308,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackaerodyn14_data( Re_Buf, Db_Buf, Int_Buf, OutData%AD14, ErrStat2, ErrMsg2 ) ! AD14 + CALL FAST_UnpackAeroDyn14_Data( Re_Buf, Db_Buf, Int_Buf, OutData%AD14, ErrStat2, ErrMsg2 ) ! AD14 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50620,7 +50348,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackinflowwind_data( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW + CALL FAST_UnpackInflowWind_Data( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50660,7 +50388,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackopenfoam_data( Re_Buf, Db_Buf, Int_Buf, OutData%OpFM, ErrStat2, ErrMsg2 ) ! OpFM + CALL FAST_UnpackOpenFOAM_Data( Re_Buf, Db_Buf, Int_Buf, OutData%OpFM, ErrStat2, ErrMsg2 ) ! OpFM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50700,7 +50428,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackscdataex_data( Re_Buf, Db_Buf, Int_Buf, OutData%SC_DX, ErrStat2, ErrMsg2 ) ! SC_DX + CALL FAST_UnpackSCDataEx_Data( Re_Buf, Db_Buf, Int_Buf, OutData%SC_DX, ErrStat2, ErrMsg2 ) ! SC_DX CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50740,7 +50468,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackseastate_data( Re_Buf, Db_Buf, Int_Buf, OutData%SeaSt, ErrStat2, ErrMsg2 ) ! SeaSt + CALL FAST_UnpackSeaState_Data( Re_Buf, Db_Buf, Int_Buf, OutData%SeaSt, ErrStat2, ErrMsg2 ) ! SeaSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50780,7 +50508,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackhydrodyn_data( Re_Buf, Db_Buf, Int_Buf, OutData%HD, ErrStat2, ErrMsg2 ) ! HD + CALL FAST_UnpackHydroDyn_Data( Re_Buf, Db_Buf, Int_Buf, OutData%HD, ErrStat2, ErrMsg2 ) ! HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50820,7 +50548,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpacksubdyn_data( Re_Buf, Db_Buf, Int_Buf, OutData%SD, ErrStat2, ErrMsg2 ) ! SD + CALL FAST_UnpackSubDyn_Data( Re_Buf, Db_Buf, Int_Buf, OutData%SD, ErrStat2, ErrMsg2 ) ! SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50860,7 +50588,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackmap_data( Re_Buf, Db_Buf, Int_Buf, OutData%MAP, ErrStat2, ErrMsg2 ) ! MAP + CALL FAST_UnpackMAP_Data( Re_Buf, Db_Buf, Int_Buf, OutData%MAP, ErrStat2, ErrMsg2 ) ! MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50900,7 +50628,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackfeamooring_data( Re_Buf, Db_Buf, Int_Buf, OutData%FEAM, ErrStat2, ErrMsg2 ) ! FEAM + CALL FAST_UnpackFEAMooring_Data( Re_Buf, Db_Buf, Int_Buf, OutData%FEAM, ErrStat2, ErrMsg2 ) ! FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50940,7 +50668,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackmoordyn_data( Re_Buf, Db_Buf, Int_Buf, OutData%MD, ErrStat2, ErrMsg2 ) ! MD + CALL FAST_UnpackMoorDyn_Data( Re_Buf, Db_Buf, Int_Buf, OutData%MD, ErrStat2, ErrMsg2 ) ! MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -50980,7 +50708,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackorcaflex_data( Re_Buf, Db_Buf, Int_Buf, OutData%Orca, ErrStat2, ErrMsg2 ) ! Orca + CALL FAST_UnpackOrcaFlex_Data( Re_Buf, Db_Buf, Int_Buf, OutData%Orca, ErrStat2, ErrMsg2 ) ! Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -51020,7 +50748,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackicefloe_data( Re_Buf, Db_Buf, Int_Buf, OutData%IceF, ErrStat2, ErrMsg2 ) ! IceF + CALL FAST_UnpackIceFloe_Data( Re_Buf, Db_Buf, Int_Buf, OutData%IceF, ErrStat2, ErrMsg2 ) ! IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -51060,7 +50788,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackicedyn_data( Re_Buf, Db_Buf, Int_Buf, OutData%IceD, ErrStat2, ErrMsg2 ) ! IceD + CALL FAST_UnpackIceDyn_Data( Re_Buf, Db_Buf, Int_Buf, OutData%IceD, ErrStat2, ErrMsg2 ) ! IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -51100,7 +50828,7 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FAST_Unpackextptfm_data( Re_Buf, Db_Buf, Int_Buf, OutData%ExtPtfm, ErrStat2, ErrMsg2 ) ! ExtPtfm + CALL FAST_UnpackExtPtfm_Data( Re_Buf, Db_Buf, Int_Buf, OutData%ExtPtfm, ErrStat2, ErrMsg2 ) ! ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN diff --git a/modules/openfast-registry/CMakeLists.txt b/modules/openfast-registry/CMakeLists.txt index 8e373eb4ac..051b9d0727 100644 --- a/modules/openfast-registry/CMakeLists.txt +++ b/modules/openfast-registry/CMakeLists.txt @@ -14,20 +14,16 @@ # limitations under the License. # -set(REGISTRY_SOURCES - src/data.c - src/gen_c_types.c - src/gen_module_files.c - src/misc.c - src/my_strtok.c - src/reg_parse.c - src/registry.c - src/sym.c - src/symtab_gen.c - src/type.c - ) - -add_executable(openfast_registry ${REGISTRY_SOURCES}) +add_executable(openfast_registry + src/main.cpp + src/registry_gen_fortran.cpp + src/registry_gen_c.cpp + src/registry_parse.cpp + src/registry.cpp + src/registry.hpp + src/templates.hpp +) +set_property(TARGET openfast_registry PROPERTY CXX_STANDARD 17) set_target_properties(openfast_registry PROPERTIES RUNTIME_OUTPUT_DIRECTORY_DEBUG ${CMAKE_BINARY_DIR}/modules/openfast-registry diff --git a/modules/openfast-registry/src/FAST_preamble.h b/modules/openfast-registry/src/FAST_preamble.h deleted file mode 100644 index 74de0a837b..0000000000 --- a/modules/openfast-registry/src/FAST_preamble.h +++ /dev/null @@ -1,45 +0,0 @@ -static char *FAST_preamble[] = { -"!*********************************************************************************************************************************\n", -"! %s_Types\n", -"!.................................................................................................................................\n", -"! This file is part of %s.\n", -"!\n", -"! Copyright (C) 2012-2016 National Renewable Energy Laboratory\n", -"!\n", -"! Licensed under the Apache License, Version 2.0 (the \"License\");\n", -"! you may not use this file except in compliance with the License.\n", -"! You may obtain a copy of the License at\n", -"!\n", -"! http://www.apache.org/licenses/LICENSE-2.0\n", -"!\n", -"! Unless required by applicable law or agreed to in writing, software\n", -"! distributed under the License is distributed on an \"AS IS\" BASIS,\n", -"! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.\n", -"! See the License for the specific language governing permissions and\n", -"! limitations under the License.\n", -"!\n", -"!\n", -"! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost.\n", -"!\n", -"!*********************************************************************************************************************************\n", -"!> This module contains the user-defined types needed in %s. It also contains copy, destroy, pack, and\n", -"!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry.\n", -"MODULE %s_Types\n", -"!---------------------------------------------------------------------------------------------------------------------------------\n", -// We may be generating the types for the library, so defer writing this: "USE NWTC_Library\n", -// We may want to tack some more USE statements on so defer writing this: "IMPLICIT NONE\n", -0L} ; - - - - - - - - - - - - - - diff --git a/modules/openfast-registry/src/Template_data.c b/modules/openfast-registry/src/Template_data.c deleted file mode 100644 index 22aa731e7e..0000000000 --- a/modules/openfast-registry/src/Template_data.c +++ /dev/null @@ -1,849 +0,0 @@ -char *template_data[] = { -"!**********************************************************************************************************************************", -"!> ## ModuleName", -"!! The ModuleName and ModuleName_Types modules make up a template for creating user-defined calculations in the FAST Modularization", -"!! Framework. ModuleName_Types will be auto-generated by the FAST registry program, based on the variables specified in the", -"!! ModuleName_Registry.txt file.", -"!!", -"! ..................................................................................................................................", -"!! ## LICENSING", -"!! Copyright (C) 2012-2013, 2015-2016 National Renewable Energy Laboratory", -"!!", -"!! This file is part of ModuleName.", -"!!", -"!! 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.", -"!**********************************************************************************************************************************", -"MODULE ModuleName", -"", -" USE ModuleName_Types", -" USE NWTC_Library", -"", -" IMPLICIT NONE", -"", -" PRIVATE", -"", -" TYPE(ProgDesc), PARAMETER :: ModName_Ver = ProgDesc( 'ModuleName', '', '' ) !< module date/version information", -"", -"", -" ! ..... Public Subroutines ...................................................................................................", -"", -" PUBLIC :: ModName_Init ! Initialization routine", -" PUBLIC :: ModName_End ! Ending routine (includes clean up)", -"", -" PUBLIC :: ModName_UpdateStates ! Loose coupling routine for solving for constraint states, integrating", -" ! continuous states, and updating discrete states", -" PUBLIC :: ModName_CalcOutput ! Routine for computing outputs", -"", -" PUBLIC :: ModName_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual", -" PUBLIC :: ModName_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states", -" PUBLIC :: ModName_UpdateDiscState ! Tight coupling routine for updating discrete states", -"", -" PUBLIC :: ModName_JacobianPInput ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete -", -" ! (Xd), and constraint - state(Z) functions all with respect to the inputs(u)", -" PUBLIC :: ModName_JacobianPContState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete -", -" ! (Xd), and constraint - state(Z) functions all with respect to the continuous", -" ! states(x)", -" PUBLIC :: ModName_JacobianPDiscState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete -", -" ! (Xd), and constraint - state(Z) functions all with respect to the discrete", -" ! states(xd)", -" PUBLIC :: ModName_JacobianPConstrState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete -", -" ! (Xd), and constraint - state(Z) functions all with respect to the constraint", -" ! states(z)", -" PUBLIC :: ModName_GetOP ! Routine to get the operating-point values for linearization (from data structures to arrays)", -"", -"CONTAINS", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> This routine is called at the start of the simulation to perform initialization steps.", -"!! The parameters are set here and not changed during the simulation.", -"!! The initial states and initial guess for the input are defined. ", -"SUBROUTINE ModName_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, InitOut, ErrStat, ErrMsg )", -"!..................................................................................................................................", -"", -" TYPE(ModName_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine", -" TYPE(ModName_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined", -" TYPE(ModName_ParameterType), INTENT( OUT) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT( OUT) :: x !< Initial continuous states", -" TYPE(ModName_DiscreteStateType), INTENT( OUT) :: xd !< Initial discrete states", -" TYPE(ModName_ConstraintStateType), INTENT( OUT) :: z !< Initial guess of the constraint states", -" TYPE(ModName_OtherStateType), INTENT( OUT) :: OtherState !< Initial other states (logical, etc)", -" TYPE(ModName_OutputType), INTENT( OUT) :: y !< Initial system outputs (outputs are not calculated;", -" !! only the output mesh is initialized)", -" TYPE(ModName_MiscVarType), INTENT( OUT) :: misc !< Misc variables for optimization (not copied in glue code)", -" REAL(DbKi), INTENT(INOUT) :: Interval !< Coupling interval in seconds: the rate that", -" !! (1) ModName_UpdateStates() is called in loose coupling &", -" !! (2) ModName_UpdateDiscState() is called in tight coupling.", -" !! Input is the suggested time from the glue code;", -" !! Output is the actual coupling interval that will be used", -" !! by the glue code.", -" TYPE(ModName_InitOutputType), INTENT( OUT) :: InitOut !< Output for initialization routine", -" INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation", -" CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None", -"", -" ! local variables", -"", -" INTEGER(IntKi) :: NumOuts ! number of outputs; would probably be in the parameter type", -" INTEGER(IntKi) :: ErrStat2 ! local error status", -" CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message", -" CHARACTER(*), PARAMETER :: RoutineName = 'ModName_Init'", -"", -" !! Initialize variables", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -" NumOuts = 2", -"", -"", -" ! Initialize the NWTC Subroutine Library", -"", -" call NWTC_Init( )", -"", -" ! Display the module information", -"", -" call DispNVD( ModName_Ver )", -"", -"", -" ! Define parameters here:", -"", -" p%DT = Interval", -"", -"", -" ! Define initial system states here:", -"", -" x%DummyContState = 0.0_ReKi", -" xd%DummyDiscState = 0.0_ReKi", -" z%DummyConstrState = 0.0_ReKi", -" OtherState%DummyOtherState = 0.0_ReKi", -"", -" ! define optimization variables here:", -" misc%DummyMiscVar = 0.0_ReKi", -"", -" ! Define initial guess for the system inputs here:", -"", -" u%DummyInput = 0.0_ReKi", -"", -"", -" ! Define system output initializations (set up mesh) here:", -" call AllocAry( y%WriteOutput, NumOuts, 'WriteOutput', ErrStat2, ErrMsg2 )", -" call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! set return error status based on local (concatenate errors)", -" if (ErrStat >= AbortErrLev) return ! if there are local variables that need to be deallocated, do so before early return", -" ", -" y%DummyOutput = 0", -" y%WriteOutput = 0", -"", -"", -" ! Define initialization-routine output here:", -" call AllocAry(InitOut%WriteOutputHdr,NumOuts,'WriteOutputHdr',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" call AllocAry(InitOut%WriteOutputUnt,NumOuts,'WriteOutputUnt',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" if (ErrStat >= AbortErrLev) return ! if there are local variables that need to be deallocated, do so before early return", -"", -" InitOut%WriteOutputHdr = (/ 'Time ', 'Column2' /)", -" InitOut%WriteOutputUnt = (/ '(s)', '(-)' /)", -"", -"", -" ! If you want to choose your own rate instead of using what the glue code suggests, tell the glue code the rate at which", -" ! this module must be called here:", -"", -" !Interval = p%DT", -"", -"", -" if (InitInp%Linearize) then", -"", -" ! If this module does not implement the four Jacobian routines at the end of this template, or the module cannot", -" ! linearize with the features that are enabled, stop the simulation if InitInp%Linearize is true.", -"", -" CALL SetErrStat( ErrID_Fatal, 'ModuleName cannot perform linearization analysis.', ErrStat, ErrMsg, RoutineName)", -"", -" ! Otherwise, if the module does allow linearization, return the appropriate Jacobian row/column names and rotating-frame flags here:", -" ! Allocate and set these variables: InitOut%LinNames_y, InitOut%LinNames_x, InitOut%LinNames_xd, InitOut%LinNames_z, InitOut%LinNames_u", -" ! Allocate and set these variables: InitOut%RotFrame_y, InitOut%RotFrame_x, InitOut%RotFrame_xd, InitOut%RotFrame_z, InitOut%RotFrame_u", -" ! Allocate and set these variables: InitOut%IsLoad_u, InitOut%DerivOrder_x", -"", -" end if", -"", -"", -"END SUBROUTINE ModName_Init", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> This routine is called at the end of the simulation.", -"SUBROUTINE ModName_End( u, p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg )", -"!..................................................................................................................................", -"", -" TYPE(ModName_InputType), INTENT(INOUT) :: u !< System inputs", -" TYPE(ModName_ParameterType), INTENT(INOUT) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states", -" TYPE(ModName_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states", -" TYPE(ModName_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states", -" TYPE(ModName_OtherStateType), INTENT(INOUT) :: OtherState !< Other states", -" TYPE(ModName_OutputType), INTENT(INOUT) :: y !< System outputs", -" TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code)", -" INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation", -" CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None", -"", -" ! local variables", -" INTEGER(IntKi) :: ErrStat2 ! local error status", -" CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message", -" CHARACTER(*), PARAMETER :: RoutineName = 'ModName_End'", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -"", -" !! Place any last minute operations or calculations here:", -"", -"", -" !! Close files here (but because of checkpoint-restart capability, it is not recommended to have files open during the simulation):", -"", -"", -" !! Destroy the input data:", -"", -" call ModName_DestroyInput( u, ErrStat2, ErrMsg2 )", -" call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -"", -"", -" !! Destroy the parameter data:", -"", -" call ModName_DestroyParam( p, ErrStat2, ErrMsg2 )", -" call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -"", -" !! Destroy the state data:", -"", -" call ModName_DestroyContState( x, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" call ModName_DestroyDiscState( xd, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" call ModName_DestroyConstrState( z, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" call ModName_DestroyOtherState( OtherState, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -"", -"", -" !! Destroy the output data:", -"", -" call ModName_DestroyOutput( y, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -"", -" ", -" !! Destroy the misc data:", -"", -" call ModName_DestroyMisc( misc, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -"", -"", -"END SUBROUTINE ModName_End", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> This is a loose coupling routine for solving constraint states, integrating continuous states, and updating discrete and other ", -"!! states. Continuous, constraint, discrete, and other states are updated to values at t + Interval.", -"SUBROUTINE ModName_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, misc, ErrStat, ErrMsg )", -"!..................................................................................................................................", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds", -" INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval", -" TYPE(ModName_InputType), INTENT(INOUT) :: Inputs(:) !< Inputs at InputTimes (output from this routine only ", -" !! because of record keeping in routines that copy meshes)", -" REAL(DbKi), INTENT(IN ) :: InputTimes(:) !< Times in seconds associated with Inputs", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t;", -" !! Output: Continuous states at t + Interval", -" TYPE(ModName_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t;", -" !! Output: Discrete states at t + Interval", -" TYPE(ModName_ConstraintStateType), INTENT(INOUT) :: z !< Input: Constraint states at t;", -" !! Output: Constraint states at t + Interval", -" TYPE(ModName_OtherStateType), INTENT(INOUT) :: OtherState !< Other states: Other states at t;", -" !! Output: Other states at t + Interval", -" TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code)", -" INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation", -" CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None", -"", -" ! Local variables", -"", -" TYPE(ModName_ContinuousStateType) :: dxdt ! Continuous state derivatives at t", -" TYPE(ModName_DiscreteStateType) :: xd_t ! Discrete states at t (copy)", -" TYPE(ModName_ConstraintStateType) :: z_Residual ! Residual of the constraint state functions (Z)", -" TYPE(ModName_InputType) :: u ! Instantaneous inputs", -" ", -" INTEGER(IntKi) :: ErrStat2 ! local error status", -" CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message", -" CHARACTER(*), PARAMETER :: RoutineName = 'ModName_UpdateStates'", -"", -"", -" ! Initialize variables", -"", -" ErrStat = ErrID_None ! no error has occurred", -" ErrMsg = ''", -"", -"", -" ! This subroutine contains an example of how the states could be updated. Developers will", -" ! want to adjust the logic as necessary for their own situations.", -"", -"", -"", -" ! Get the inputs at time t, based on the array of values sent by the glue code:", -"", -" ! before calling ExtrapInterp routine, memory in u must be allocated; we can do that with a copy:", -" call ModName_CopyInput( Inputs(1), u, MESH_NEWCOPY, ErrStat2, ErrMsg2 )", -" call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" if ( ErrStat >= AbortErrLev ) then", -" call cleanup() ! to avoid memory leaks, we have to destroy the local variables that may have allocatable arrays or meshes", -" return", -" end if", -"", -" call ModName_Input_ExtrapInterp( Inputs, InputTimes, u, t, ErrStat2, ErrMsg2 ) ", -" call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" if ( ErrStat >= AbortErrLev ) then", -" call cleanup()", -" return", -" end if", -"", -"", -"", -" ! Get first time derivatives of continuous states (dxdt):", -"", -" call ModName_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, misc, dxdt, ErrStat2, ErrMsg2 )", -" call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" if ( ErrStat >= AbortErrLev ) then", -" call cleanup()", -" return", -" end if", -"", -"", -" ! Update discrete states:", -" ! Note that xd [discrete state] is changed in ModName_UpdateDiscState() so xd will now contain values at t+Interval", -" ! We'll first make a copy that contains xd at time t, which will be used in computing the constraint states", -" call ModName_CopyDiscState( xd, xd_t, MESH_NEWCOPY, ErrStat2, ErrMsg2 )", -" call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" if ( ErrStat >= AbortErrLev ) then", -" call cleanup()", -" return", -" end if", -"", -" call ModName_UpdateDiscState( t, n, u, p, x, xd, z, OtherState, misc, ErrStat2, ErrMsg2 )", -" call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" if ( ErrStat >= AbortErrLev ) then", -" call cleanup()", -" return", -" end if", -"", -"", -" ! Solve for the constraint states (z) here:", -"", -" ! Iterate until the value is within a given tolerance.", -"", -" ! DO ", -"", -" call ModName_CalcConstrStateResidual( t, u, p, x, xd_t, z, OtherState, misc, Z_Residual, ErrStat2, ErrMsg2 )", -" call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName)", -" if ( ErrStat >= AbortErrLev ) then", -" call cleanup()", -" return", -" end if", -"", -" ! z =", -"", -" ! END DO", -"", -"", -"", -" ! Integrate (update) continuous states (x) here:", -"", -" !x = function of dxdt and x", -"", -"", -" ! Destroy local variables before returning", -" call cleanup()", -"", -"", -"CONTAINS", -" SUBROUTINE cleanup()", -" ! note that this routine inherits all of the data in ModName_UpdateStates", -"", -"", -" CALL ModName_DestroyInput( u, ErrStat2, ErrMsg2)", -" CALL ModName_DestroyConstrState( Z_Residual, ErrStat2, ErrMsg2)", -" CALL ModName_DestroyContState( dxdt, ErrStat2, ErrMsg2)", -" CALL ModName_DestroyDiscState( xd_t, ErrStat2, ErrMsg2) ", -"", -" END SUBROUTINE cleanup", -"END SUBROUTINE ModName_UpdateStates", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> This is a routine for computing outputs, used in both loose and tight coupling.", -"SUBROUTINE ModName_CalcOutput( t, u, p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg )", -"!..................................................................................................................................", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds", -" TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t", -" TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t", -" TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t", -" TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t", -" TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code)", -" TYPE(ModName_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con-", -" !! nectivity information does not have to be recalculated)", -" INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation", -" CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None", -"", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -"", -" ! Compute outputs here:", -" y%DummyOutput = 2.0_ReKi", -"", -" y%WriteOutput(1) = REAL(t,ReKi)", -" y%WriteOutput(2) = 1.0_ReKi", -"", -"", -"END SUBROUTINE ModName_CalcOutput", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> This is a tight coupling routine for computing derivatives of continuous states.", -"SUBROUTINE ModName_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, misc, dxdt, ErrStat, ErrMsg )", -"!..................................................................................................................................", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds", -" TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t", -" TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t", -" TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t", -" TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t", -" TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code)", -" TYPE(ModName_ContinuousStateType), INTENT( OUT) :: dxdt !< Continuous state derivatives at t", -" INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation", -" CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None", -"", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -"", -" ! Compute the first time derivatives of the continuous states here:", -"", -" dxdt%DummyContState = 0.0_ReKi", -"", -"", -"END SUBROUTINE ModName_CalcContStateDeriv", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> This is a tight coupling routine for updating discrete states.", -"SUBROUTINE ModName_UpdateDiscState( t, n, u, p, x, xd, z, OtherState, misc, ErrStat, ErrMsg )", -"!..................................................................................................................................", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds", -" INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval", -" TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t", -" TYPE(ModName_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t;", -" !! Output: Discrete states at t + Interval", -" TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t", -" TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t", -" TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code)", -" INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation", -" CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None", -"", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -"", -" ! Update discrete states here:", -"", -" xd%DummyDiscState = 0.0_Reki", -"", -"END SUBROUTINE ModName_UpdateDiscState", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> This is a tight coupling routine for solving for the residual of the constraint state functions.", -"SUBROUTINE ModName_CalcConstrStateResidual( t, u, p, x, xd, z, OtherState, misc, Z_residual, ErrStat, ErrMsg )", -"!..................................................................................................................................", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds", -" TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t", -" TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t", -" TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t (possibly a guess)", -" TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t", -" TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code)", -" TYPE(ModName_ConstraintStateType), INTENT( OUT) :: Z_residual !< Residual of the constraint state functions using", -" !! the input values described above", -" INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation", -" CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None", -"", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -"", -" ! Solve for the residual of the constraint state functions here:", -"", -" Z_residual%DummyConstrState = 0.0_ReKi", -"", -"END SUBROUTINE ModName_CalcConstrStateResidual", -"", -"", -"!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++", -"! ###### The following four routines are Jacobian routines for linearization capabilities #######", -"! If the module does not implement them, set ErrStat = ErrID_Fatal in ModName_Init() when InitInp%Linearize is .true.", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions", -"!! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned.", -"SUBROUTINE ModName_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu)", -"!..................................................................................................................................", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point", -" TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required)", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point", -" TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point", -" TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point", -" TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point", -" TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required);", -" !! Output fields are not used by this routine, but type is", -" !! available here so that mesh parameter information (i.e.,", -" !! connectivity) does not have to be recalculated for dYdu.", -" TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables", -" INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation", -" CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect", -" !! to the inputs (u) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with", -" !! respect to the inputs (u) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with", -" !! respect to the inputs (u) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with", -" !! respect to the inputs (u) [intent in to avoid deallocation]", -"", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -"", -" IF ( PRESENT( dYdu ) ) THEN", -"", -" ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here:", -"", -" ! allocate and set dYdu", -"", -" END IF", -"", -" IF ( PRESENT( dXdu ) ) THEN", -"", -" ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here:", -"", -" ! allocate and set dXdu", -"", -" END IF", -"", -" IF ( PRESENT( dXddu ) ) THEN", -"", -" ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the inputs (u) here:", -"", -" ! allocate and set dXddu", -"", -" END IF", -"", -" IF ( PRESENT( dZdu ) ) THEN", -"", -" ! Calculate the partial derivative of the constraint state functions (Z) with respect to the inputs (u) here:", -"", -" ! allocate and set dZdu", -"", -" END IF", -"", -"", -"END SUBROUTINE ModName_JacobianPInput", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions", -"!! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned.", -"SUBROUTINE ModName_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx )", -"!..................................................................................................................................", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point", -" TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required)", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point", -" TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point", -" TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point", -" TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point", -" TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required);", -" !! Output fields are not used by this routine, but type is", -" !! available here so that mesh parameter information (i.e.,", -" !! connectivity) does not have to be recalculated for dYdx.", -" TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables", -" INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation", -" CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions", -" !! (Y) with respect to the continuous", -" !! states (x) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state", -" !! functions (X) with respect to", -" !! the continuous states (x) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state", -" !! functions (Xd) with respect to", -" !! the continuous states (x) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state", -" !! functions (Z) with respect to", -" !! the continuous states (x) [intent in to avoid deallocation]", -"", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -"", -"", -" IF ( PRESENT( dYdx ) ) THEN", -"", -" ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here:", -"", -" ! allocate and set dYdx", -"", -" END IF", -"", -" IF ( PRESENT( dXdx ) ) THEN", -"", -" ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here:", -"", -" ! allocate and set dXdx", -"", -" END IF", -"", -" IF ( PRESENT( dXddx ) ) THEN", -"", -" ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the continuous states (x) here:", -"", -" ! allocate and set dXddx", -"", -" END IF", -"", -" IF ( PRESENT( dZdx ) ) THEN", -"", -"", -" ! Calculate the partial derivative of the constraint state functions (Z) with respect to the continuous states (x) here:", -"", -" ! allocate and set dZdx", -"", -" END IF", -"", -"", -"END SUBROUTINE ModName_JacobianPContState", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions", -"!! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd are returned.", -"SUBROUTINE ModName_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd )", -"!..................................................................................................................................", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point", -" TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required)", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point", -" TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point", -" TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point", -" TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point", -" TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required);", -" !! Output fields are not used by this routine, but type is", -" !! available here so that mesh parameter information (i.e.,", -" !! connectivity) does not have to be recalculated for dYdxd.", -" TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables", -" INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation", -" CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdxd(:,:) !< Partial derivatives of output functions", -" !! (Y) with respect to the discrete", -" !! states (xd) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdxd(:,:) !< Partial derivatives of continuous state", -" !! functions (X) with respect to the", -" !! discrete states (xd) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddxd(:,:)!< Partial derivatives of discrete state", -" !! functions (Xd) with respect to the", -" !! discrete states (xd) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdxd(:,:) !< Partial derivatives of constraint state", -" !! functions (Z) with respect to the", -" !! discrete states (xd) [intent in to avoid deallocation]", -"", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -"", -" IF ( PRESENT( dYdxd ) ) THEN", -"", -" ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd) here:", -"", -" ! allocate and set dYdxd", -"", -" END IF", -"", -" IF ( PRESENT( dXdxd ) ) THEN", -"", -" ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd) here:", -"", -" ! allocate and set dXdxd", -"", -" END IF", -"", -" IF ( PRESENT( dXddxd ) ) THEN", -"", -" ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd) here:", -"", -" ! allocate and set dXddxd", -"", -" END IF", -"", -" IF ( PRESENT( dZdxd ) ) THEN", -"", -" ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd) here:", -"", -" ! allocate and set dZdxd", -"", -" END IF", -"", -"", -"END SUBROUTINE ModName_JacobianPDiscState", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions", -"!! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and dZ/dz are returned.", -"SUBROUTINE ModName_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz )", -"!..................................................................................................................................", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point", -" TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required)", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point", -" TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point", -" TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point", -" TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point", -" TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required);", -" !! Output fields are not used by this routine, but type is", -" !! available here so that mesh parameter information (i.e.,", -" !! connectivity) does not have to be recalculated for dYdz.", -" TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables", -" INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation", -" CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdz(:,:) !< Partial derivatives of output", -" !! functions (Y) with respect to the", -" !! constraint states (z) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdz(:,:) !< Partial derivatives of continuous", -" !! state functions (X) with respect to", -" !! the constraint states (z) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddz(:,:) !< Partial derivatives of discrete state", -" !! functions (Xd) with respect to the", -" !! constraint states (z) [intent in to avoid deallocation]", -" REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdz(:,:) !< Partial derivatives of constraint", -" !! state functions (Z) with respect to", -" !! the constraint states (z) [intent in to avoid deallocation]", -"", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -" IF ( PRESENT( dYdz ) ) THEN", -"", -" ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here:", -"", -" ! allocate and set dYdz", -"", -" END IF", -"", -" IF ( PRESENT( dXdz ) ) THEN", -"", -" ! Calculate the partial derivative of the continuous state functions (X) with respect to the constraint states (z) here:", -"", -" ! allocate and set dXdz", -"", -" END IF", -"", -" IF ( PRESENT( dXddz ) ) THEN", -"", -" ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the constraint states (z) here:", -"", -" ! allocate and set dXddz", -"", -" END IF", -"", -" IF ( PRESENT( dZdz ) ) THEN", -"", -" ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here:", -"", -" ! allocate and set dZdz", -"", -" END IF", -"", -"", -"END SUBROUTINE ModName_JacobianPConstrState", -"!----------------------------------------------------------------------------------------------------------------------------------", -"!> Routine to pack the data structures representing the operating points into arrays for linearization.", -"SUBROUTINE ModName_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op )", -"", -" REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point", -" TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required)", -" TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters", -" TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point", -" TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point", -" TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point", -" TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point", -" TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output at operating point", -" TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables", -" INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation", -" CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None", -" REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs", -" REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs", -" REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states", -" REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states", -" REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states", -" REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states", -"", -"", -" ! Initialize ErrStat", -"", -" ErrStat = ErrID_None", -" ErrMsg = ''", -"", -" IF ( PRESENT( u_op ) ) THEN", -"", -" END IF", -"", -" IF ( PRESENT( y_op ) ) THEN", -" END IF", -"", -" IF ( PRESENT( x_op ) ) THEN", -"", -" END IF", -"", -" IF ( PRESENT( dx_op ) ) THEN", -"", -" END IF", -"", -" IF ( PRESENT( xd_op ) ) THEN", -"", -" END IF", -"", -" IF ( PRESENT( z_op ) ) THEN", -"", -" END IF", -"", -"END SUBROUTINE ModName_GetOP", -"!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++", -"", -"END MODULE ModuleName", -"!**********************************************************************************************************************************", -0L } ; diff --git a/modules/openfast-registry/src/Template_registry.c b/modules/openfast-registry/src/Template_registry.c deleted file mode 100644 index e06dc7dcad..0000000000 --- a/modules/openfast-registry/src/Template_registry.c +++ /dev/null @@ -1,81 +0,0 @@ -char *template_registry[] = { -"###################################################################################################################################", -"# Registry for ModuleName in the FAST Modularization Framework", -"# This Registry file is used to create MODULE ModuleName_Types, which contains all of the user-defined types needed in ModuleName.", -"# It also contains copy, destroy, pack, and unpack routines associated with each defined data types.", -"#", -"# Entries are of the form", -"# keyword ", -"#", -"# Use ^ as a shortcut for the value from the previous line.", -"# See NWTC Programmer's Handbook at https://nwtc.nrel.gov/FAST-Developers for further information on the format/contents of this file.", -"###################################################################################################################################", -"", -"# ...... Include files (definitions from NWTC Library) ............................................................................", -"include Registry_NWTC_Library.txt", -"", -"", -"# ..... Initialization data .......................................................................................................", -"# Define inputs that the initialization routine may need here:", -"# e.g., the name of the input file, the file root name, etc.", -"typedef ModuleName/ModName InitInputType CHARACTER(1024) InputFile - - - \"Name of the input file; remove if there is no file\" -", -"typedef ^ ^ LOGICAL Linearize - .FALSE. - \"Flag that tells this module if the glue code wants to linearize.\" -", -"", -"# Define outputs from the initialization routine here:", -"typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - \"Names of the output-to-file channels\" -", -"typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - \"Units of the output-to-file channels\" -", -"# if this module has implemented linearization, return the names of the rows/columns of the Jacobian matrices:", -"#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - \"Names of the outputs used in linearization\" - ", -"#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_x {:} - - \"Names of the continuous states used in linearization\" -", -"#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_xd {:} - - \"Names of the discrete states used in linearization\" -", -"#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_z {:} - - \"Names of the constraint states used in linearization\" -", -"#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_u {:} - - \"Names of the inputs used in linearization\" -", -"#typedef ^ InitOutputType LOGICAL RotFrame_y {:} - - \"Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame\" -", -"#typedef ^ InitOutputType LOGICAL RotFrame_x {:} - - \"Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame\" -", -"#typedef ^ InitOutputType LOGICAL RotFrame_xd {:} - - \"Flag that tells FAST if the discrete states used in linearization are in the rotating frame\" -", -"#typedef ^ InitOutputType LOGICAL RotFrame_z {:} - - \"Flag that tells FAST if the constraint states used in linearization are in the rotating frame\" -", -"#typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - \"Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame\" -", -"#typedef ^ InitOutputType LOGICAL IsLoad_u {:} - - \"Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrices)\" -", -"#typedef ^ InitOutputType IntKi DerivOrder_x {:} - - \"Integer that tells FAST/MBC3 the order derivative for the continuous states used in linearization\" -", -"", -"", -"# ..... States ....................................................................................................................", -"# Define continuous (differentiable) states here:", -"typedef ^ ContinuousStateType ReKi DummyContState - - - \"Remove this variable if you have continuous states\" -", -"", -"# Define discrete (nondifferentiable) states here:", -"typedef ^ DiscreteStateType ReKi DummyDiscState - - - \"Remove this variable if you have discrete states\" -", -"", -"# Define constraint states here:", -"typedef ^ ConstraintStateType ReKi DummyConstrState - - - \"Remove this variable if you have constraint states\" -", -"", -"# Define any other states, including integer or logical states here:", -"typedef ^ OtherStateType IntKi DummyOtherState - - - \"Remove this variable if you have other states\" -", -"", -"", -"# ..... 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 ReKi DummyMiscVar - - - \"Remove this variable if you have misc/optimization variables\" -", -"", -"", -"# ..... 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 DbKi DT - - - \"Time step for cont. state integration & disc. state update\" seconds", -"", -"", -"# ..... Inputs ....................................................................................................................", -"# Define inputs that are contained on the mesh here:", -"#typedef ^ InputType MeshType MeshedInput - - - \"Meshed data\" -", -"# Define inputs that are not on this mesh here:", -"typedef ^ InputType ReKi DummyInput - - - \"Remove this variable if you have input data\" -", -"", -"", -"# ..... Outputs ...................................................................................................................", -"# Define outputs that are contained on the mesh here:", -"#typedef ^ OutputType MeshType MeshedOutput - - - \"Meshed data\" -", -"# Define outputs that are not on this mesh here:", -"typedef ^ OutputType ReKi WriteOutput {:} - - \"Example of data to be written to an output file\" \"s,-\"", -"", -0L } ; diff --git a/modules/openfast-registry/src/data.c b/modules/openfast-registry/src/data.c deleted file mode 100644 index 3224b9118c..0000000000 --- a/modules/openfast-registry/src/data.c +++ /dev/null @@ -1,229 +0,0 @@ -#include -#include -#include -#ifdef _WIN32 -#define rindex(X,Y) strrchr(X,Y) -#define index(X,Y) strchr(X,Y) -#define bzero(X,Y) memset(X,0,Y) -#else -# include -#endif - -#include "registry.h" -#include "protos.h" -#include "data.h" - -int -init_modname_table() -{ - ModNames = NULL ; - return(0) ; -} - -int -init_dim_table() -{ - Dim = NULL ; - return(0) ; -} - -node_t * -new_node ( int kind ) -{ node_t *p ; - p = (node_t *)malloc(sizeof(node_t)) ; - bzero(p,sizeof(node_t)); - p->node_kind = kind ; - - p->fields = NULL; - p->params = NULL; - p->type = NULL; - p->module = NULL; - p->module_ddt_list = NULL; - p->next = NULL; - //p->coord_end_param = NULL; - strcpy(p->dim_param_name, ""); - p->dim_param = 0; - p->type_type = 0; - p->max_ndims = 0; - p->containsPtr = 0; - p->ndims = 0; - p->deferred = 0; - p->usefrom = 0; - p->is_interface_type = 0; - strcpy(p->name, ""); - strcpy(p->mapsto, ""); - strcpy(p->nickname, ""); - strcpy(p->descrip, ""); - strcpy(p->units, ""); - - return (p) ; } - -int -add_node_to_end ( node_t * node , node_t ** list ) -{ - node_t * p ; - if ( *list == NULL ) - { *list = node ; } - else - { - for ( p = *list ; p->next != NULL ; p = p->next ) ; - p->next = node ; - } - return(0) ; -} - -int -add_node_to_beg ( node_t * node , node_t ** list ) -{ - node_t * p ; - if ( *list == NULL ) - { - *list = node ; - (*list)->next = NULL ; - } - else - { -//fprintf(stderr," add_node_to_beg: node %s to existing list. CH %s CN %08x\n", node->name,(*list)->name,(*list)->next) ; -//if ( (*list)->next ) fprintf(stderr," CN name %s\n",(*list)->next->name ) ; - p = (*list) ; - *list = node ; - (*list)->next = p ; - } - return(0) ; -} - - -#if 0 -int -add_node_to_end_4d ( node_t * node , node_t ** list ) -{ - node_t * p ; - if ( *list == NULL ) - { *list = node ; } - else - { - for ( p = *list ; p->next4d != NULL ; p = p->next4d ) ; - p->next4d = node ; - } - return(0) ; -} -#endif - -#if 1 - -void -show_nodelist( node_t * p ) -{ - show_nodelist1( p , 0 ) ; -} - -void -show_nodelist1( node_t * p , int indent ) -{ - if ( p == NULL ) return; - show_node1( p, indent) ; - show_nodelist1( p->next, indent ) ; -} - -int -show_node( node_t * p ) -{ - return(show_node1(p,0)) ; -} - -int -show_node1( node_t * p, int indent ) -{ - char spaces[] = " " ; - char tmp[25] , t1[25] , t2[25] ; - char * x, *ca, *ld, *ss, *se, *sg ; - char *nodekind ; - int nl ; - int i ; - - if ( p == NULL ) return(1) ; - strcpy(tmp, spaces) ; - if ( indent >= 0 && indent < 20 ) tmp[indent] = '\0' ; - -// this doesn't make much sense any more, ever since node_kind was -// changed to a bit mask - nodekind = "" ; - if ( p->node_kind & FIELD ) nodekind = "FIELD" ; - else if ( p->node_kind & MODNAME ) nodekind = "MODNAME" ; - else if ( p->node_kind & TYPE ) nodekind = "TYPE" ; - - switch ( p->node_kind ) - { - case MODNAME : - fprintf(stderr,"%s%s : %s nickname %s\n",tmp,nodekind,p->name,p->nickname) ; - show_nodelist1(p->module_ddt_list, indent+1) ; - break ; - case FIELD : - fprintf(stderr,"%s%s : %10s ndims %1d\n",tmp,nodekind,p->name, p->ndims) ; - for ( i = 0 ; i < p->ndims ; i++ ) - { - sg = "" ; - ca = "" ; - switch ( p->dims[i]->coord_axis ) { - case COORD_C : ca = "C" ; break ; - } - switch ( p->dims[i]->len_defined_how ) { - case DOMAIN_STANDARD : ld = "STANDARD" ; ss = "" ; se = "" ; break ; - case CONSTANT : ld = "CONSTANT" ; sprintf(t1,"%d",p->dims[i]->coord_start) ; ss = t1 ; - sprintf(t2,"%d",p->dims[i]->coord_end ) ; se = t2 ; - break ; - } - fprintf(stderr," dim %0d: {%s} %2s%s %10s %10s %10s\n",i,p->dims[i]->dim_name,ca,sg,ld,ss,se) ; - } - nl = 0 ; - if ( strlen( p->use ) > 0 ) { - nl = 1 ; fprintf(stderr," use: %s",p->use) ; - } - if ( strlen( p->descrip ) > 0 ) { nl = 1 ; fprintf(stderr," descrip: %s",p->descrip) ; } - if ( nl == 1 ) fprintf(stderr,"\n") ; - show_node1( p->type, indent+1 ) ; - break ; - case TYPE : - x = "derived" ; - if ( p->type_type == SIMPLE ) x = "simple" ; - fprintf(stderr,"%sTYPE : %10s %s ndims %1d\n",tmp,p->name,x, p->ndims) ; - show_nodelist1( p->fields, indent+1 ) ; - break ; - case DIM : - break ; - default : - break ; - } - return(0) ; -} -#endif - -int -set_mark ( int val , node_t * lst ) -{ - node_t * p ; - if ( lst == NULL ) return(0) ; - for ( p = lst ; p != NULL ; p = p->next ) - { - p->mark = val ; - set_mark( val , p->fields ) ; - } - return(0) ; -} - -#if 0 -int -set_mark_4d ( int val , node_t * lst ) -{ - node_t * p ; - if ( lst == NULL ) return(0) ; - for ( p = lst ; p != NULL ; p = p->next4d ) - { - p->mark = val ; - set_mark( val , p->fields ) ; - set_mark( val , p->members ) ; - } - return(0) ; -} -#endif - diff --git a/modules/openfast-registry/src/data.h b/modules/openfast-registry/src/data.h deleted file mode 100644 index 4680d1539e..0000000000 --- a/modules/openfast-registry/src/data.h +++ /dev/null @@ -1,134 +0,0 @@ -#ifndef DATA_H -#include "registry.h" - -typedef struct node_struct { - - int node_kind ; - int type_type ; - char name[NAMELEN] ; - char mapsto[NAMELEN] ; - char nickname[NAMELEN] ; - struct node_struct * fields ; - struct node_struct * params ; - struct node_struct * type ; - struct node_struct * module ; /* type node pointer back to module node it is defined in */ - int max_ndims; // max number of dimensions (so we don't have hundreds of unused variables that produce warnings) - int containsPtr; // if contains a pointer in type/subtype - int ndims ; - struct node_struct * dims[MAXDIMS] ; - int proc_orient ; /* ALL_[ZXY]_ON_PROC which dimension is all on processor */ - int ntl ; - int subject_to_communication ; - int boundary_array ; - int boundary_array_4d ; - char use[NAMELEN] ; - char inival[NAMELEN] ; - char descrip[NAMELEN] ; - char units[NAMELEN] ; - -/* I/O flags */ - int restart ; - int boundary ; - int namelist ; - char namelistsection[NAMELEN] ; - -/* Fields for Modname */ - struct node_struct * module_ddt_list ; - - -/* CTRL */ - int gen_periodic ; - struct node_struct * next ; - -/* fields used by rconfig nodes */ - char nentries[NAMELEN] ; - char howset[NAMELEN] ; - char dflt[NAMELEN] ; - -/* fields used by Dim nodes */ - - char dim_name[32] ; - char dim_data_name[NAMELEN] ; - int coord_axis ; /* X, Y, Z, C */ - /* DOMAIN_STANDARD, NAMELIST, CONSTANT */ - int len_defined_how ; - char assoc_nl_var_s[NAMELEN] ; /* for NAMELIST */ - char assoc_nl_var_e[NAMELEN] ; /* for NAMELIST */ - int coord_start ; /* for CONSTANT */ - int coord_end ; /* for CONSTANT */ - int dim_param; /* for using PARAMETER dimension */ - char dim_param_name[NAMELEN]; /* for using PARAMETER dimension */ - - int dim_order ; /* order that dimensions are specified - in framework */ - int subgrid ; /* 1=subgrid dimension */ - int deferred ; /* a deferred-shape dimension, that is, a colon */ - - int usefrom ; - -/* fields used by Package nodes */ - char pkg_assoc[NAMELEN] ; - char pkg_statevars[NAMELEN] ; - char pkg_4dscalars[NAMELEN_LONG] ; - -/* fields used by Comm (halo, period, xpose) nodes */ - char comm_define[2*8192] ; - - int is_interface_type ; - -/* array pointer instead of allocatable*/ - int is_pointer; /* 0 = allocatable, 1 = pointer */ -/* marker */ - int mark ; - -} node_t ; - -#ifndef DEFINE_GLOBALS -# define EXTERN extern -#else -# define EXTERN -#endif - -EXTERN int sw_output_template_force ; -EXTERN char sw_commpath[NAMELEN] ; -EXTERN char sw_modname_subst[NAMELEN] ; -EXTERN char sw_modnickname_subst[NAMELEN] ; -EXTERN int sw_new_bdys ; /* 20070207 JM support decomposed boundary arrays */ -EXTERN int sw_unidir_shift_halo ; /* 20100210 JM assume that halo to shift is same in both directions and only gen one of them */ -EXTERN int sw_new_with_old_bdys ; /* 20070207 JM for debugging interim phase, new comms w/ old data structs */ -EXTERN int sw_norealloc_lsh; /* 20070207 addresses compilers like gfortran that do not /assume:realloc_lhs */ -EXTERN int sw_ccode ; /* 20130523 generate C code too */ -EXTERN int sw_noextrap; -EXTERN char sw_shownodes ; - -EXTERN node_t * Type ; -EXTERN node_t * Dim ; -EXTERN node_t * Packages ; -EXTERN node_t * Halos ; -EXTERN node_t * Periods ; -EXTERN node_t * Xposes ; -EXTERN node_t * FourD ; -EXTERN node_t * Swaps ; -EXTERN node_t * Cycles ; -EXTERN node_t * ModNames ; - -EXTERN node_t Domain ; - -EXTERN char t1[NAMELEN], t2[NAMELEN], t3[NAMELEN], t4[NAMELEN], t5[NAMELEN], t6[NAMELEN] ; -EXTERN char thiscom[NAMELEN] ; - -EXTERN int max_time_level ; /* Maximum number of time levels of any state variable */ - -#define MAXINCLDIRS 50 -EXTERN int nincldirs ; -EXTERN char IncludeDirs[MAXINCLDIRS][NAMELEN] ; -EXTERN char OutDir[NAMELEN]; - -#define P_XSB 1 -#define P_XEB 2 -#define P_YSB 3 -#define P_YEB 4 - - -#define DATA_H -#endif diff --git a/modules/openfast-registry/src/gen_c_types.c b/modules/openfast-registry/src/gen_c_types.c deleted file mode 100644 index 74bd14d662..0000000000 --- a/modules/openfast-registry/src/gen_c_types.c +++ /dev/null @@ -1,428 +0,0 @@ -#include -#include -#include -#include -#ifndef _WIN32 -# include -#endif - -#include "protos.h" -#include "registry.h" -#include "data.h" - - -#if 0 -void -gen_c_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) -{ - char tmp[NAMELEN], tmp2[NAMELEN], tmp3[NAMELEN], tmp4[NAMELEN], addnick[NAMELEN], nonick[NAMELEN] ; - node_t *q, * r ; - int d, idim, frst ; - - remove_nickname(ModName->nickname,inout,nonick) ; - append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; - sprintf(tmp,"%s",addnick) ; - if (( q = get_entry( make_lower_temp(tmp),ModName->module_ddt_list ) ) == NULL ) - { - fprintf(stderr,"Registry warning: generating %s_Unpack%s: cannot find definition for %s\n",ModName->nickname,nonick,tmp) ; - return;//(1) ; - } - -fprintf(fp,"\nint\n") ; -fprintf(fp,"C_%s_Unpack%s( float * ReKiBuf, \n",ModName->nickname,nonick) ; -fprintf(fp," double * DbKiBuf, \n") ; -fprintf(fp," int * IntKiBuf, \n") ; -fprintf(fp," %s_t *OutData, char * ErrMsg )\n", addnick) ; -fprintf(fp,"{\n") ; -fprintf(fp," int ErrStat = 0;\n") ; -fprintf(fp," int Re_BufSz2 = 0 ;\n") ; -fprintf(fp," int Db_BufSz2 = 0 ;\n") ; -fprintf(fp," int Int_BufSz2 = 0 ;\n") ; -fprintf(fp," int Re_Xferred = 0 ;\n") ; -fprintf(fp," int Db_Xferred = 0 ;\n") ; -fprintf(fp," int Int_Xferred = 0 ;\n") ; -fprintf(fp," int Re_CurrSz = 0 ;\n") ; -fprintf(fp," int Db_CurrSz = 0 ;\n") ; -fprintf(fp," int Int_CurrSz = 0 ;\n") ; -fprintf(fp," int one = 1 ;\n") ; -fprintf(fp," int i,i1,i2,i3,i4,i5 ;\n") ; - - fprintf(fp," // buffers to store meshes, if any\n") ; - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type == NULL ) { - fprintf(stderr,"Registry warning generating %s_Unpack%s: %s has no type.\n",ModName->nickname,nonick,r->name) ; - return ; // EARLY RETURN - } else { - if ( !strcmp( r->type->name, "meshtype" ) || (r->type->type_type == DERIVED && ! r->type->usefrom ) ) { - fprintf(fp," float * Re_%s_Buf ;\n",r->name) ; - fprintf(fp," double * Db_%s_Buf ;\n",r->name) ; - fprintf(fp," int * Int_%s_Buf ;\n",r->name) ; - } - } - } -fprintf(fp," ReKiBuf = NULL ;\n") ; -fprintf(fp," DbKiBuf = NULL ;\n") ; -fprintf(fp," IntKiBuf = NULL ;\n") ; - - // Unpack data - frst = 1 ; - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type->type_type == DERIVED && ! r->type->usefrom && strcmp(make_lower_temp(r->type->mapsto),"meshtype") ) { - char nonick2[NAMELEN] ; - remove_nickname(ModName->nickname,r->type->name,nonick2) ; - fprintf(fp," // first call %s_Pack%s to get correctly sized buffers for unpacking\n", - ModName->nickname,fast_interface_type_shortname(nonick2)) ; - fprintf(fp," ErrStat = C_%s_Pack%s( Re_%s_Buf, &Re_BufSz2, Db_%s_Buf, &Db_BufSz2, Int_%s_Buf, &Int_BufSz2, &(OutData->%s%s), ErrMsg, &one ) ; // %s \n", - ModName->nickname,fast_interface_type_shortname(nonick2), r->name, r->name, r->name, r->name, dimstr_c(r->ndims),r->name ) ; - - fprintf(fp," if ( Re_%s_Buf != NULL ) {\n",r->name) ; - fprintf(fp," memcpy( Re_%s_Buf, &(ReKiBuf[ Re_Xferred] ), Re_BufSz2 ) ;\n",r->name ) ; - fprintf(fp," Re_Xferred += Re_BufSz2 ; // %s \n",r->name) ; - fprintf(fp," }\n" ) ; - fprintf(fp," if ( Db_%s_Buf != NULL ) {\n",r->name) ; - fprintf(fp," memcpy( Db_%s_Buf, &(DbKiBuf[ Db_Xferred] ), Db_BufSz2 ) ;\n",r->name ) ; - fprintf(fp," Db_Xferred += Db_BufSz2 ; // %s \n",r->name) ; - fprintf(fp," }\n" ) ; - fprintf(fp," if ( Int_%s_Buf != NULL ) {\n",r->name) ; - fprintf(fp," memcpy( Int_%s_Buf, &(IntKiBuf[ Int_Xferred] ), Int_BufSz2 ) ;\n",r->name ) ; - fprintf(fp," Int_Xferred += Int_BufSz2 ; // %s \n",r->name) ; - fprintf(fp," }\n" ) ; - fprintf(fp," ErrStat = C_%s_Unpack%s( Re_%s_Buf, Db_%s_Buf, Int_%s_Buf, &(OutData->%s%s), ErrMsg ) ; // %s \n", - ModName->nickname,fast_interface_type_shortname(nonick2), r->name, r->name, r->name, r->name, - dimstr(r->ndims), - r->name ) ; -// fprintf(fp," if ( Re_%s_Buf != NULL) { free(Re_%s_Buf) ; Re_%s_Buf = NULL ;} \n",r->name, r->name, r->name) ; -// fprintf(fp," if ( Db_%s_Buf != NULL) { free(Db_%s_Buf) ; Db_%s_Buf = NULL ;}\n",r->name, r->name, r->name) ; -// fprintf(fp," if ( Int_%s_Buf != NULL) { free(Int_%s_Buf) ; Int_%s_Buf = NULL ;} \n",r->name, r->name, r->name) ; - - } else { - char * indent, * ty ; - char arrayname[NAMELEN], tmp[NAMELEN], tmp2[NAMELEN] ; - - sprintf(arrayname,"OutData%%%s",r->name) ; - sprintf(tmp2,"SIZE(OutData%%%s)",r->name) ; - if ( r->ndims==0 ) { strcpy(tmp3,"") ; } - else if ( r->ndims==1 ) { strcpy(tmp3,"") ; } - else if ( r->ndims==2 ) { sprintf(tmp3,"(1:(%s),1)",tmp2) ; } - else if ( r->ndims==3 ) { sprintf(tmp3,"(1:(%s),1,1)",tmp2) ; } - else if ( r->ndims==4 ) { sprintf(tmp3,"(1:(%s),1,1,1)",tmp2) ; } - else if ( r->ndims==5 ) { sprintf(tmp3,"(1:(%s),1,1,1,1)",tmp2) ; } - else { fprintf(stderr,"Registry WARNING: too many dimensions for %s\n",r->name) ; } - indent = "" ; - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") || - !strcmp( r->type->mapsto, "REAL(DbKi)") || - !strcmp( r->type->mapsto, "INTEGER(IntKi)") ) { - if ( r->ndims > 0 && has_deferred_dim( r, 0 )) { - fprintf(fp," if ( OutData->%s != NULL ) {\n", r->name ) ; - indent = " " ; - } - - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") ) ty = "Re" ; - if ( !strcmp( r->type->mapsto, "REAL(DbKi)") ) ty = "Db" ; - if ( !strcmp( r->type->mapsto, "REAL(IntKi)") ) ty = "Int" ; - - if ( r->ndims > 0 ) { - if ( has_deferred_dim( r, 0 ) ) { - fprintf(fp,"%s memcpy( OutData->%s,&(%sKiBuf[ %s_Xferred ]),OutData->%s_Len) ;\n",indent,r->name,ty,ty,r->name) ; - fprintf(fp,"%s %s_Xferred = %s_Xferred + OutData->%s_Len ; \n",indent,ty,ty,r->name ) ; - } else { - int i ; - strcpy(tmp2,"") ; - for ( i = 0 ; i < r->ndims ; i++ ) - { - sprintf(tmp,"((%d)-(%d)+1)",r->dims[i]->coord_end,r->dims[i]->coord_start) ; - strcat(tmp2,tmp) ; - if ( i < r->ndims-1 ) strcat(tmp2,"*") ; - } - fprintf(fp,"%s memcpy( OutData->%s,&(%sKiBuf[ %s_Xferred ]),(%s)*sizeof(%s)) ;\n", - indent,r->name,ty,ty,tmp2,C_type(r->type->mapsto)) ; - fprintf(fp,"%s %s_Xferred = %s_Xferred + (%s)*sizeof(%s) ; \n", - indent,ty,ty,tmp2,C_type(r->type->mapsto) ) ; - } - } else { - fprintf(fp,"%s OutData->%s = %sKiBuf [ %s_Xferred ] ; \n",indent,r->name,ty,ty) ; - fprintf(fp,"%s %s_Xferred = %s_Xferred + 1 ; \n",indent,ty,ty ) ; - } - - if ( r->ndims > 0 && has_deferred_dim( r, 0 )) { - fprintf(fp," }\n" ) ; - } - - } - } - } - fprintf(fp," if ( ReKiBuf != NULL ) free(ReKiBuf) ;\n") ; - fprintf(fp," if ( DbKiBuf != NULL ) free(DbKiBuf) ;\n") ; - fprintf(fp," if ( IntKiBuf != NULL ) free(IntKiBuf) ;\n") ; - fprintf(fp," return(ErrStat) ;\n") ; - fprintf(fp,"}\n") ; - return;//(0) ; -} - -void -gen_c_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) -{ - char tmp[NAMELEN], tmp2[NAMELEN], tmp3[NAMELEN], addnick[NAMELEN], nonick[NAMELEN] ; - node_t *q, * r ; - int frst, d ; - - remove_nickname(ModName->nickname,inout,nonick) ; - append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; - sprintf(tmp,"%s",addnick) ; - if (( q = get_entry( make_lower_temp(tmp),ModName->module_ddt_list ) ) == NULL ) - { - fprintf(stderr,"Registry warning: generating %s_Pack%s: cannot find definition for %s\n",ModName->nickname,nonick,tmp) ; - return;//(1) ; - } -fprintf(fp,"\nint\n") ; -fprintf(fp,"C_%s_Pack%s( float * ReKiBuf, int * Re_BufSz ,\n",ModName->nickname,nonick) ; -fprintf(fp," double * DbKiBuf, int * Db_BufSz ,\n") ; -fprintf(fp," int * IntKiBuf, int * Int_BufSz ,\n") ; -fprintf(fp," %s_t *InData, char * ErrMsg, int *SizeOnly )\n", addnick) ; -fprintf(fp,"{\n") ; -fprintf(fp," int ErrStat = 0;\n") ; -fprintf(fp," int OnlySize ;\n") ; -fprintf(fp," int Re_BufSz2 ;\n") ; -fprintf(fp," int Db_BufSz2 ;\n") ; -fprintf(fp," int Int_BufSz2 ;\n") ; -fprintf(fp," int Re_Xferred = 0 ;\n") ; -fprintf(fp," int Db_Xferred = 0 ;\n") ; -fprintf(fp," int Int_Xferred = 0 ;\n") ; -fprintf(fp," int one = 1 ;\n") ; -fprintf(fp," int i,i1,i2,i3,i4,i5 ;\n") ; -fprintf(fp," // buffers to store meshes and subtypes, if any\n") ; - - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type == NULL ) { - fprintf(stderr,"Registry warning generating %s_Pack%s: %s has no type.\n",ModName->nickname,nonick,r->name) ; - return ; // EARLY RETURN - } else { - if ( !strcmp( r->type->name, "meshtype" ) || (r->type->type_type == DERIVED && ! r->type->usefrom ) ) { - fprintf(fp," float * Re_%s_Buf ;\n",r->name) ; - fprintf(fp," double * Db_%s_Buf ;\n",r->name) ; - fprintf(fp," int * Int_%s_Buf ;\n",r->name) ; - } - } - } - -fprintf(fp,"\n") ; -fprintf(fp," OnlySize = *SizeOnly ;\n") ; -fprintf(fp,"\n") ; -fprintf(fp," *Re_BufSz = 0 ;\n") ; -fprintf(fp," *Db_BufSz = 0 ;\n") ; -fprintf(fp," *Int_BufSz = 0 ;\n") ; -fprintf(fp," ReKiBuf = NULL ;\n") ; -fprintf(fp," DbKiBuf = NULL ;\n") ; -fprintf(fp," IntKiBuf = NULL ;\n") ; - frst = 1 ; - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type->type_type == DERIVED && ! r->type->usefrom && strcmp(make_lower_temp(r->type->mapsto),"meshtype") ) { - char nonick2[NAMELEN] ; - remove_nickname(ModName->nickname,r->type->name,nonick2) ; - fprintf(fp," ErrStat = C_%s_Pack%s( Re_%s_Buf, &Re_BufSz2 ,\n", - ModName->nickname,fast_interface_type_shortname(nonick2), r->name) ; - fprintf(fp," Db_%s_Buf, &Db_BufSz2 ,\n",r->name ) ; - fprintf(fp," Int_%s_Buf, &Int_BufSz2 , &(InData->%s%s), ErrMsg, &one ) ; // %s \n", - r->name, r->name, dimstr(r->ndims), r->name ) ; - fprintf(fp," *Re_BufSz += Re_BufSz2 ; // %s\n",r->name ) ; - fprintf(fp," *Db_BufSz += Db_BufSz2 ; // %s\n",r->name ) ; - fprintf(fp," *Int_BufSz += Int_BufSz2 ; // %s\n",r->name ) ; - fprintf(fp," if ( Re_%s_Buf != NULL) { free(Re_%s_Buf) ; Re_%s_Buf = NULL ;} \n",r->name, r->name, r->name) ; - fprintf(fp," if ( Db_%s_Buf != NULL) { free(Db_%s_Buf) ; Db_%s_Buf = NULL ;}\n",r->name, r->name, r->name) ; - fprintf(fp," if ( Int_%s_Buf != NULL) { free(Int_%s_Buf) ; Int_%s_Buf = NULL ;} \n",r->name, r->name, r->name) ; - } else if ( r->ndims == 0 ) { // scalars - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") ) { - fprintf(fp," *Re_BufSz += 1 ; // %s\n",r->name ) ; - } - else if ( !strcmp( r->type->mapsto, "REAL(DbKi)") ) { - fprintf(fp," *Db_BufSz += 1 ; // %s\n",r->name ) ; - } - else if ( !strcmp( r->type->mapsto, "INTEGER(IntKi)") ) { - fprintf(fp," *Int_BufSz += 1 ; // %s\n",r->name ) ; - } - } else { // r->ndims > 0 - if ( r->dims[0]->deferred ) { - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") ) { - fprintf(fp," *Re_BufSz += InData->%s_Len ; // %s \n", r->name , r->name ) ; - } - else if ( !strcmp( r->type->mapsto, "REAL(DbKi)") ) { - fprintf(fp," *Db_BufSz += InData->%s_Len ; // %s \n", r->name , r->name ) ; - } - else if ( !strcmp( r->type->mapsto, "INTEGER(IntKi)") ) { - fprintf(fp," *Int_BufSz += InData->%s_Len ; // %s \n", r->name , r->name ) ; - } - } else { - } - } - } - - fprintf(fp," if ( ! OnlySize ) {\n") ; - // Allocate buffers - fprintf(fp," if ( *Re_BufSz > 0 ) ReKiBuf = (float *)malloc(*Re_BufSz*sizeof(float) ) ;\n") ; - fprintf(fp," if ( *Db_BufSz > 0 ) DbKiBuf = (double *)malloc(*Db_BufSz*sizeof(double) ) ;\n") ; - fprintf(fp," if ( *Int_BufSz > 0 ) IntKiBuf = (int *)malloc(*Int_BufSz*sizeof(int) ) ;\n") ; - - // Pack data - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type->type_type == DERIVED && ! r->type->usefrom && strcmp(make_lower_temp(r->type->mapsto),"meshtype") ) { - char nonick2[NAMELEN] ; - remove_nickname(ModName->nickname,r->type->name,nonick2) ; - fprintf(fp," ErrStat = C_%s_Pack%s( Re_%s_Buf, &Re_BufSz2 ,\n", - ModName->nickname,fast_interface_type_shortname(nonick2), r->name) ; - fprintf(fp," Db_%s_Buf, &Db_BufSz2 ,\n",r->name ) ; - fprintf(fp," Int_%s_Buf, &Int_BufSz2 , &(InData->%s%s), ErrMsg, &one ) ; // %s \n", - r->name, r->name, dimstr(r->ndims), r->name ) ; - - fprintf(fp," if ( Re_%s_Buf != NULL ) {\n",r->name) ; - fprintf(fp," memcpy( &ReKiBuf[Re_Xferred], Re_%s_Buf, Re_BufSz2*sizeof(float) ) ;\n",r->name) ; - fprintf(fp," Re_Xferred += Re_BufSz2 ;\n") ; - fprintf(fp," }\n" ) ; - fprintf(fp," if ( Db_%s_Buf != NULL ) {\n",r->name) ; - fprintf(fp," memcpy( &DbKiBuf[Db_Xferred], Db_%s_Buf, Db_BufSz2*sizeof(double) ) ;\n",r->name) ; - fprintf(fp," Db_Xferred += Db_BufSz2 ;\n") ; - fprintf(fp," }\n" ) ; - fprintf(fp," if ( Int_%s_Buf != NULL ) {\n",r->name) ; - fprintf(fp," memcpy( &IntKiBuf[Int_Xferred], Int_%s_Buf, Int_BufSz2*sizeof(int) ) ;\n",r->name) ; - fprintf(fp," Int_Xferred += Int_BufSz2 ;\n") ; - fprintf(fp," }\n" ) ; - fprintf(fp," if ( Re_%s_Buf != NULL) { free(Re_%s_Buf) ; Re_%s_Buf = NULL ;} \n",r->name, r->name, r->name) ; - fprintf(fp," if ( Db_%s_Buf != NULL) { free(Db_%s_Buf) ; Db_%s_Buf = NULL ;}\n",r->name, r->name, r->name) ; - fprintf(fp," if ( Int_%s_Buf != NULL) { free(Int_%s_Buf) ; Int_%s_Buf = NULL ;} \n",r->name, r->name, r->name) ; - - } else { - char * indent, *ty, *cty ; - sprintf(tmp2,"InData->%s_Len)",r->name) ; - if ( r->ndims==0 ) { - strcpy(tmp3,"") ; - } else if ( r->ndims==1 ) { - strcpy(tmp3,"") ; - } else if ( r->ndims==2 ) { - sprintf(tmp3,"(1:(%s),1)",tmp2) ; - } else if ( r->ndims==3 ) { - sprintf(tmp3,"(1:(%s),1,1)",tmp2) ; - } else if ( r->ndims==4 ) { - sprintf(tmp3,"(1:(%s),1,1,1)",tmp2) ; - } else if ( r->ndims==5 ) { - sprintf(tmp3,"(1:(%s),1,1,1,1)",tmp2) ; - } else { - fprintf(stderr,"Registry WARNING: too many dimensions for %s\n",r->name) ; - } - indent = " " ; - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") || - !strcmp( r->type->mapsto, "REAL(DbKi)") || - !strcmp( r->type->mapsto, "INTEGER(IntKi)") ) - { - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") ) {ty = "Re" ; cty = "float" ; } - else if ( !strcmp( r->type->mapsto, "REAL(DbKi)") ) {ty = "Db" ; cty = "double" ; } - else if ( !strcmp( r->type->mapsto, "REAL(IntKi)") ) {ty = "Int" ; cty = "int" ; } - indent = " " ; - if ( r->ndims > 0 && has_deferred_dim( r, 0 )) { - fprintf(fp,"%sfor ( i = 0 ; i < InData->%s_Len ; i++ ) {\n",indent, r->name ) ; - fprintf(fp,"%s if ( !OnlySize ) memcpy( &(%sKiBuf[%s_Xferred+i]), &(InData->%s[i]), sizeof(%s)) ;\n", - indent,ty,ty,r->name,cty ) ; - fprintf(fp,"%s %s_Xferred++ ;\n",indent,ty) ; - fprintf(fp,"%s}\n",indent) ; - } else if ( r->ndims == 0 ) { - fprintf(fp," %sKiBuf[%s_Xferred++] = InData->%s ;\n",ty,ty,r->name) ; - } - } - } - } - -fprintf(fp," }\n") ; -fprintf(fp," return(ErrStat) ;\n") ; -fprintf(fp,"}\n") ; -return;//(0) ; -} -#endif - - -void -gen_c_module( FILE * fph, node_t * ModName ) -{ - node_t * q, * r ; - int i ; - char nonick[NAMELEN], star ; - - if ( strlen(ModName->nickname) > 0 ) { -// generate each derived data type - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - if ( q->usefrom == 0 ) { - if (*q->mapsto) remove_nickname(ModName->nickname, make_lower_temp(q->mapsto), nonick); - fprintf(fph, " typedef struct %s {\n",q->mapsto) ; - //if (!strcmp(make_lower_temp(nonick), "otherstatetype") !strcmp(make_lower_temp(nonick), "initinputtype")){ - fprintf(fph, " void * object ;\n"); - //} - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type != NULL ) { - star = ' ' ; - if ( r->ndims > 0 ) { - if ( has_deferred_dim(r, 0) ) star = '*'; - } - if ( r->type->type_type == DERIVED ) { - if ( strcmp(make_lower_temp(r->type->mapsto),"meshtype") ) { // do not output mesh types for C code, - //fprintf(fph," struct %s %c%s",r->type->mapsto,star,r->name ) ; - } - } else { - char tmp[NAMELEN] ; tmp[0] = '\0' ; - if (*q->mapsto) remove_nickname( ModName->nickname, make_lower_temp(q->mapsto) , tmp ) ; - if (r->ndims > 0 && has_deferred_dim(r, 0)) { - fprintf(fph," %s * %s ; ",C_type( r->type->mapsto), r->name ) ; - fprintf(fph," int %s_Len ;",r->name ) ; - } else { - char *p = r->type->mapsto; - char buf[10]; -// bjj: this assumes all character strings are defined with numeric lengths -// It should be modified to allow use of parameters, too. (and parameters defined in the registry should also be defined in the .h file) - while (*p) { - if (isdigit(*p)) { - long val = strtol(p, &p, 10); - snprintf(buf, 10, "%lu", val); - } else { - p++; - } - - - } - if (strcmp(C_type(r->type->mapsto), "char") == 0 ){ // if it's a char we need to add the array size - if (r->ndims == 0) - fprintf(fph," %s %s[%s] ;",C_type( r->type->mapsto ),r->name,buf ) ; - } else { // else, it's just a double or int value - fprintf(fph," %s %s ;",C_type( r->type->mapsto ),r->name ) ; - } - } - } - for ( i = 0 ; i < r->ndims ; i++ ) - { - if (!has_deferred_dim(r, 0) && (strcmp(C_type(r->type->mapsto), "char") || r->ndims == 0)) // skip this for characters? - fprintf(fph,"[%d] ;",r->dims[i]->coord_end - r->dims[i]->coord_start +1) ; - } - fprintf(fph, "\n"); - } - } - fprintf(fph," } %s_t ;\n", q->mapsto ) ; - } - } - - - fprintf(fph," typedef struct %s_UserData {\n", ModName->nickname) ; - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - remove_nickname(ModName->nickname,q->name,nonick) ; - if ( is_a_fast_interface_type(nonick) ) { - char temp[NAMELEN] ; - sprintf(temp, "%s_t", q->mapsto ) ; - fprintf(fph," %-30s %s_%s ;\n", temp, ModName->nickname, fast_interface_type_shortname(nonick) ) ; - } - } - fprintf(fph," } %s_t ;\n", ModName->nickname ) ; - - } -} diff --git a/modules/openfast-registry/src/gen_module_files.c b/modules/openfast-registry/src/gen_module_files.c deleted file mode 100644 index 1d15ebfe08..0000000000 --- a/modules/openfast-registry/src/gen_module_files.c +++ /dev/null @@ -1,2521 +0,0 @@ -#include -#include -#include -#ifndef _WIN32 -# include -#endif - -#include "protos.h" -#include "registry.h" -#include "data.h" - -#include "FAST_preamble.h" - -void gen_mask_alloc( FILE *fp, int ndims, char *tmp ); - -/** - * ============== Create the C2Farry Copy Subroutine in ModName_Types.f90 ====================== - * - * In the C2F routines, we associate the pointer created in C with the variables in the - * corresponding Fortran types. - * ====================================================================================== - */ -int -gen_copy_c2f( FILE *fp , // *.f90 file we are writting to - const node_t *ModName , // module name - char *inout , // character string written out - char *inoutlong ) // not sure what this is used for -{ - node_t *q, *r ; - char tmp[NAMELEN]; - char addnick[NAMELEN]; - char nonick[NAMELEN] ; - - remove_nickname(ModName->nickname,inout,nonick) ; - append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; - fprintf(fp," SUBROUTINE %s_C2Fary_Copy%s( %sData, ErrStat, ErrMsg, SkipPointers )\n", ModName->nickname, nonick,nonick ); - fprintf(fp," TYPE(%s), INTENT(INOUT) :: %sData\n" , addnick, nonick ); - fprintf(fp," INTEGER(IntKi), INTENT( OUT) :: ErrStat\n" ); - fprintf(fp," CHARACTER(*), INTENT( OUT) :: ErrMsg\n" ); - fprintf(fp," LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers\n" ); - fprintf(fp," ! \n" ); - fprintf(fp," LOGICAL :: SkipPointers_local\n"); - fprintf(fp," ErrStat = ErrID_None\n" ); - fprintf(fp," ErrMsg = \"\"\n\n" ); - fprintf(fp," IF (PRESENT(SkipPointers)) THEN\n"); - fprintf(fp," SkipPointers_local = SkipPointers\n"); - fprintf(fp," ELSE\n"); - fprintf(fp," SkipPointers_local = .false.\n"); - fprintf(fp," END IF\n"); - - sprintf(tmp,"%s",addnick) ; - - if (( q = get_entry( make_lower_temp(tmp),ModName->module_ddt_list ) ) == NULL ) - { - fprintf(stderr,"Registry warning: generating %s_C2Fary_Copy%s: cannot find definition for %s\n",ModName->nickname,nonick,tmp) ; - } else { - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type != NULL ) { - if ( r->type->type_type == DERIVED ) { // && ! r->type->usefrom - fprintf(stderr,"Registry WARNING: derived data type %s of type %s is not passed through C interface\n",r->name,r->type->name) ; - } else { - if ( is_pointer(r) ) { - fprintf(fp,"\n ! -- %s %s Data fields\n",r->name,nonick) ; - fprintf(fp," IF ( .NOT. SkipPointers_local ) THEN\n"); - fprintf(fp," IF ( .NOT. C_ASSOCIATED( %sData%%C_obj%%%s ) ) THEN\n",nonick,r->name) ; - fprintf(fp," NULLIFY( %sData%%%s )\n",nonick,r->name) ; - fprintf(fp," ELSE\n") ; - fprintf(fp," CALL C_F_POINTER(%sData%%C_obj%%%s, %sData%%%s, (/%sData%%C_obj%%%s_Len/))\n",nonick,r->name,nonick,r->name,nonick,r->name) ; - fprintf(fp," END IF\n") ; - fprintf(fp, " END IF\n"); - } - else if (!has_deferred_dim(r, 0)) { - if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)") || - !strcmp(r->type->mapsto, "REAL(DbKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)") || - !strcmp(r->type->mapsto, "INTEGER(IntKi)") || - !strcmp(r->type->mapsto, "LOGICAL")) - { - fprintf(fp, " %sData%%%s = %sData%%C_obj%%%s\n", nonick, r->name, nonick, r->name); - } - else { // characters need to be copied differently - if (r->ndims == 0){ - fprintf(fp, " %sData%%%s = TRANSFER(%sData%%C_obj%%%s, %sData%%%s )\n", nonick, r->name, nonick, r->name, nonick, r->name); - } - } - } - } - } - } - } - - fprintf(fp," END SUBROUTINE %s_C2Fary_Copy%s\n\n", ModName->nickname,nonick ) ; - return(0) ; -} - -int -gen_copy_f2c(FILE *fp, // *.f90 file we are writting to - const node_t *ModName, // module name - char *inout, // character string written out - char *inoutlong) // not sure what this is used for -{ - node_t *q, *r; - char tmp[NAMELEN]; - char addnick[NAMELEN]; - char nonick[NAMELEN]; - - remove_nickname(ModName->nickname, inout, nonick); - append_nickname((is_a_fast_interface_type(inoutlong)) ? ModName->nickname : "", inoutlong, addnick); - fprintf(fp, " SUBROUTINE %s_F2C_Copy%s( %sData, ErrStat, ErrMsg, SkipPointers )\n", ModName->nickname, nonick, nonick); - fprintf(fp, " TYPE(%s), INTENT(INOUT) :: %sData\n", addnick, nonick); - fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n"); - fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"); - fprintf(fp, " LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers\n"); - fprintf(fp, " ! \n"); - fprintf(fp, " LOGICAL :: SkipPointers_local\n"); - fprintf(fp, " ErrStat = ErrID_None\n"); - fprintf(fp, " ErrMsg = \"\"\n\n"); - fprintf(fp, " IF (PRESENT(SkipPointers)) THEN\n"); - fprintf(fp, " SkipPointers_local = SkipPointers\n"); - fprintf(fp, " ELSE\n"); - fprintf(fp, " SkipPointers_local = .false.\n"); - fprintf(fp, " END IF\n"); - - sprintf(tmp, "%s", addnick); - - if ((q = get_entry(make_lower_temp(tmp), ModName->module_ddt_list)) == NULL) - { - fprintf(stderr, "Registry warning: generating %s_F2C_Copy%s: cannot find definition for %s\n", ModName->nickname, nonick, tmp); - } - else { - for (r = q->fields; r; r = r->next) - { - if (r->type != NULL) { - if (r->type->type_type == DERIVED) { // && ! r->type->usefrom - fprintf(stderr, "Registry WARNING: derived data type %s of type %s is not passed through F-C interface\n", r->name, r->type->name); - } - else { - if (is_pointer(r)) { - fprintf(fp, "\n ! -- %s %s Data fields\n", r->name, nonick); - fprintf(fp, " IF ( .NOT. SkipPointers_local ) THEN\n"); - fprintf(fp, " IF ( .NOT. %s(%sData%%%s)) THEN \n", assoc_or_allocated(r), nonick, r->name); - fprintf(fp, " %sData%%c_obj%%%s_Len = 0\n", nonick, r->name); - fprintf(fp, " %sData%%c_obj%%%s = C_NULL_PTR\n", nonick, r->name); - fprintf(fp, " ELSE\n"); - fprintf(fp, " %sData%%c_obj%%%s_Len = SIZE(%sData%%%s)\n", nonick, r->name, nonick, r->name); - fprintf(fp, " IF (%sData%%c_obj%%%s_Len > 0) &\n", nonick, r->name); - - fprintf(fp, " %sData%%c_obj%%%s = C_LOC( %sData%%%s(", nonick, r->name, nonick, r->name); - for (int d = 1; d <= r->ndims; d++) { - fprintf(fp, " LBOUND(%sData%%%s,%d)", nonick, r->name, d); - if (d < r->ndims) { fprintf(fp, ","); } - } - fprintf(fp, " ) )\n"); - - fprintf(fp, " END IF\n"); - fprintf(fp, " END IF\n"); - } - else if (!has_deferred_dim(r, 0)) { - if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)") || - !strcmp(r->type->mapsto, "REAL(DbKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)") || - !strcmp(r->type->mapsto, "INTEGER(IntKi)") || - !strcmp(r->type->mapsto, "LOGICAL")) - { - fprintf(fp, " %sData%%C_obj%%%s = %sData%%%s\n", nonick, r->name, nonick, r->name); - } - else { // characters need to be copied differently - if (r->ndims == 0) { - //fprintf(stderr, "Registry WARNING: character data type %s of type %s is not passed through F-C interface\n", r->name, r->type->name); - fprintf(fp, " %sData%%C_obj%%%s = TRANSFER(%sData%%%s, %sData%%C_obj%%%s )\n", nonick, r->name, nonick, r->name, nonick, r->name); - } - } - } - } - } - } - } - - fprintf(fp, " END SUBROUTINE %s_F2C_Copy%s\n\n", ModName->nickname, nonick); - return(0); -} - - -int -gen_copy( FILE * fp, const node_t * ModName, char * inout, char * inoutlong, const node_t * q_in ) -{ - char tmp[NAMELEN], tmp2[NAMELEN], addnick[NAMELEN], nonick[NAMELEN] ; - node_t *q, * r ; - int d ; - - remove_nickname(ModName->nickname,inout,nonick) ; - append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; - fprintf(fp," SUBROUTINE %s_Copy%s( Src%sData, Dst%sData, CtrlCode, ErrStat, ErrMsg )\n",ModName->nickname,nonick,nonick,nonick ) ; - fprintf(fp, " TYPE(%s), INTENT(%s) :: Src%sData\n", addnick, (q_in->containsPtr == 1) ? "INOUT" : "IN", nonick); -//fprintf(fp, " TYPE(%s), INTENT(INOUT) :: Src%sData\n", addnick, nonick); - fprintf(fp," TYPE(%s), INTENT(INOUT) :: Dst%sData\n",addnick,nonick) ; - fprintf(fp," INTEGER(IntKi), INTENT(IN ) :: CtrlCode\n") ; - fprintf(fp," INTEGER(IntKi), INTENT( OUT) :: ErrStat\n") ; - fprintf(fp," CHARACTER(*), INTENT( OUT) :: ErrMsg\n") ; - fprintf(fp,"! Local \n") ; - fprintf(fp," INTEGER(IntKi) :: i,j,k\n") ; - for (d = 1; d <= q_in->max_ndims; d++){ - fprintf(fp, " INTEGER(IntKi) :: i%d, i%d_l, i%d_u ! bounds (upper/lower) for an array dimension %d\n", d, d, d, d); - } - fprintf(fp," INTEGER(IntKi) :: ErrStat2\n") ; - fprintf(fp," CHARACTER(ErrMsgLen) :: ErrMsg2\n"); - fprintf(fp," CHARACTER(*), PARAMETER :: RoutineName = '%s_Copy%s'\n", ModName->nickname, nonick); - fprintf(fp, "! \n"); - fprintf(fp," ErrStat = ErrID_None\n") ; - fprintf(fp," ErrMsg = \"\"\n") ; - -// sprintf(tmp,"%s_%s",ModName->nickname,inoutlong) ; -// sprintf(tmp,"%s",inoutlong) ; - sprintf(tmp,"%s",addnick) ; - - sprintf(tmp2,"%s",make_lower_temp(tmp)) ; - - if (( q = get_entry( make_lower_temp(tmp),ModName->module_ddt_list ) ) == NULL ) - { - fprintf(stderr,"Registry warning: generating %s_Copy%s: cannot find definition for %s\n",ModName->nickname,nonick,tmp) ; - } else { - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type != NULL ) { - -// check if this is an allocatable array: - if ( r->ndims > 0 && has_deferred_dim(r,0) ) { - fprintf(fp,"IF (%s(Src%sData%%%s)) THEN\n",assoc_or_allocated(r),nonick,r->name) ; - strcpy(tmp,"") ; - - for (d = 1; d <= r->ndims; d++) { - fprintf(fp, " i%d_l = LBOUND(Src%sData%%%s,%d)\n", d, nonick, r->name, d); - fprintf(fp, " i%d_u = UBOUND(Src%sData%%%s,%d)\n", d, nonick, r->name, d); - sprintf(tmp2, ",i%d_l:i%d_u", d, d); - strcat(tmp, tmp2); - } -//fprintf(fp," nonick=%s\n", nonick ); - fprintf(fp," IF (.NOT. %s(Dst%sData%%%s)) THEN \n",assoc_or_allocated(r),nonick,r->name) ; - fprintf(fp," ALLOCATE(Dst%sData%%%s(%s),STAT=ErrStat2)\n",nonick,r->name,(char*)&(tmp[1])) ; - fprintf(fp," IF (ErrStat2 /= 0) THEN \n") ; - fprintf(fp," CALL SetErrStat(ErrID_Fatal, 'Error allocating Dst%sData%%%s.', ErrStat, ErrMsg,RoutineName)\n",nonick,r->name); - fprintf(fp," RETURN\n") ; - fprintf(fp," END IF\n") ; - - if ( sw_ccode && is_pointer(r) ) { // bjj: this needs to be updated if we've got multiple dimension arrays - fprintf(fp," Dst%sData%%c_obj%%%s_Len = SIZE(Dst%sData%%%s)\n",nonick,r->name,nonick,r->name) ; - fprintf(fp," IF (Dst%sData%%c_obj%%%s_Len > 0) &\n",nonick,r->name) ; - - fprintf(fp, " Dst%sData%%c_obj%%%s = C_LOC( Dst%sData%%%s(", nonick, r->name, nonick, r->name); - for (d = 1; d <= r->ndims; d++) { - fprintf(fp, " i%d_l", d); - if (d < r->ndims) { fprintf(fp, ","); } - } - fprintf(fp, " ) )\n"); - - } - - fprintf(fp," END IF\n") ; // end dest allocated/associated - } - - if ( r->type->type_type == DERIVED ) { // includes mesh and dll_type - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp," DO i%d = LBOUND(Src%sData%%%s,%d), UBOUND(Src%sData%%%s,%d)\n",d,nonick,r->name,d,nonick,r->name,d ) ; - } - - if (!strcmp(r->type->name, "meshtype")) { - fprintf(fp," CALL MeshCopy( Src%sData%%%s%s, Dst%sData%%%s%s, CtrlCode, ErrStat2, ErrMsg2 )\n",nonick,r->name,dimstr(r->ndims),nonick,r->name,dimstr(r->ndims)) ; - fprintf(fp," CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"); - fprintf(fp," IF (ErrStat>=AbortErrLev) RETURN\n"); - } else if ( !strcmp( r->type->name, "dll_type" ) ) { - fprintf(fp," Dst%sData%%%s = Src%sData%%%s\n",nonick,r->name,nonick,r->name) ; - } - else { // && ! r->type->usefrom ) { - char nonick2[NAMELEN]; - remove_nickname(r->type->module->nickname, r->type->name, nonick2); - - fprintf(fp, " CALL %s_Copy%s( Src%sData%%%s%s, Dst%sData%%%s%s, CtrlCode, ErrStat2, ErrMsg2 )\n", - r->type->module->nickname, fast_interface_type_shortname(nonick2), - nonick, r->name, dimstr(r->ndims), - nonick, r->name, dimstr(r->ndims)); - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " IF (ErrStat>=AbortErrLev) RETURN\n"); - - } - - for ( d = r->ndims ; d >= 1 ; d-- ) { - fprintf(fp," ENDDO\n") ; - } - } else { // not a derived type - fprintf(fp, " Dst%sData%%%s = Src%sData%%%s\n",nonick,r->name,nonick,r->name) ; - if (sw_ccode && !is_pointer(r)){ - - //if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - // !strcmp(r->type->mapsto, "REAL(SiKi)") || - // !strcmp(r->type->mapsto, "REAL(DbKi)") || - // !strcmp(r->type->mapsto, "REAL(R8Ki)") || - // !strcmp(r->type->mapsto, "INTEGER(IntKi)") || - // !strcmp(r->type->mapsto, "LOGICAL") || - // r->ndims == 0) - if ( r->ndims == 0 ) // scalar of any type OR a character array - { - // fprintf(fp, " Dst%sData%%C_obj%%%s = Dst%sData%%%s\n", nonick, r->name, nonick, r->name); - fprintf(fp, " Dst%sData%%C_obj%%%s = Src%sData%%C_obj%%%s\n", nonick, r->name, nonick, r->name); - } - } - } - -// close IF (check on allocatable array) - if ( r->ndims > 0 && has_deferred_dim(r,0) ) { - fprintf(fp,"ENDIF\n") ; - } - - } // if non-null field - } // each field - } - - fprintf(fp," END SUBROUTINE %s_Copy%s\n\n", ModName->nickname,nonick ) ; - return(0) ; -} - -void -gen_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) -{ - - char tmp[NAMELEN], tmp2[NAMELEN], addnick[NAMELEN], nonick[NAMELEN] ; - char nonick2[NAMELEN], indent[NAMELEN], mainIndent[6]; - node_t *q, * r ; - int frst, d, i; - - remove_nickname(ModName->nickname,inout,nonick) ; - append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; -// sprintf(tmp,"%s_%s",ModName->nickname,inoutlong) ; -// sprintf(tmp,"%s",inoutlong) ; - sprintf(tmp,"%s",addnick) ; - if (( q = get_entry( make_lower_temp(tmp),ModName->module_ddt_list ) ) == NULL ) - { - fprintf(stderr,"Registry warning: generating %s_Pack%s: cannot find definition for %s\n",ModName->nickname,nonick,tmp) ; - return;//(1) ; - } - - fprintf(fp, " SUBROUTINE %s_Pack%s( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly )\n", ModName->nickname,nonick) ; - fprintf(fp, " REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:)\n") ; - fprintf(fp, " REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:)\n") ; - fprintf(fp, " INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:)\n") ; - fprintf(fp, " TYPE(%s), INTENT(IN) :: InData\n",addnick ) ; - fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n") ; - fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg\n") ; - fprintf(fp, " LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly\n") ; - fprintf(fp, " ! Local variables\n") ; - fprintf(fp, " INTEGER(IntKi) :: Re_BufSz\n") ; - fprintf(fp, " INTEGER(IntKi) :: Re_Xferred\n") ; - fprintf(fp, " INTEGER(IntKi) :: Db_BufSz\n") ; - fprintf(fp, " INTEGER(IntKi) :: Db_Xferred\n") ; - fprintf(fp, " INTEGER(IntKi) :: Int_BufSz\n") ; - fprintf(fp, " INTEGER(IntKi) :: Int_Xferred\n") ; - fprintf(fp, " INTEGER(IntKi) :: i,i1,i2,i3,i4,i5\n") ; - fprintf(fp, " LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers\n") ; - fprintf(fp, " INTEGER(IntKi) :: ErrStat2\n"); - fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2\n"); - fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_Pack%s'\n", ModName->nickname, nonick); - - fprintf(fp, " ! buffers to store subtypes, if any\n"); - fprintf(fp, " REAL(ReKi), ALLOCATABLE :: Re_Buf(:)\n"); - fprintf(fp, " REAL(DbKi), ALLOCATABLE :: Db_Buf(:)\n"); - fprintf(fp, " INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:)\n\n"); - - fprintf(fp," OnlySize = .FALSE.\n") ; - fprintf(fp," IF ( PRESENT(SizeOnly) ) THEN\n") ; - fprintf(fp," OnlySize = SizeOnly\n") ; - fprintf(fp," ENDIF\n") ; - fprintf(fp," !\n") ; - - fprintf(fp," ErrStat = ErrID_None\n") ; - fprintf(fp," ErrMsg = \"\"\n") ; - fprintf(fp," Re_BufSz = 0\n") ; - fprintf(fp," Db_BufSz = 0\n") ; - fprintf(fp," Int_BufSz = 0\n") ; - - - frst = 1; - for (r = q->fields; r; r = r->next) - { - if (r->type == NULL) { - fprintf(stderr, "Registry warning generating %s_Pack%s: %s has no type.\n", ModName->nickname, nonick, r->name); - return; // EARLY RETURN - } - - if (has_deferred_dim(r, 0)){ - //fprintf(fp, "\n"); - fprintf(fp, " Int_BufSz = Int_BufSz + 1 ! %s allocated yes/no\n", r->name); - - fprintf(fp, " IF ( %s(InData%%%s) ) THEN\n", assoc_or_allocated(r), r->name); - fprintf(fp, " Int_BufSz = Int_BufSz + 2*%d ! %s upper/lower bounds for each dimension\n", r->ndims, r->name); - } - - if (!strcmp(r->type->name, "meshtype") || - !strcmp(r->type->name, "dll_type") || - (r->type->type_type == DERIVED) ) { // call individual routines to pack data from subtypes: - - if (frst == 1) { - fprintf(fp, " ! Allocate buffers for subtypes, if any (we'll get sizes from these) \n"); frst = 0; - } - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " DO i%d = LBOUND(InData%%%s,%d), UBOUND(InData%%%s,%d)\n", d, r->name, d, r->name, d); - } - fprintf(fp, " Int_BufSz = Int_BufSz + 3 ! %s: size of buffers for each call to pack subtype\n", r->name); - - if ( !strcmp( r->type->name, "meshtype" ) ) { - fprintf(fp, " CALL MeshPack( InData%%%s%s, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! %s \n", - r->name,dimstr(r->ndims),r->name ) ; - } else if ( !strcmp( r->type->name, "dll_type" ) ) { - fprintf(fp, " CALL DLLTypePack( InData%%%s%s, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! %s \n", - r->name,dimstr(r->ndims), r->name ) ; - } else if (r->type->type_type == DERIVED) { // && ! r->type->usefrom ) { - remove_nickname(r->type->module->nickname, r->type->name, nonick2); - fprintf(fp, " CALL %s_Pack%s( Re_Buf, Db_Buf, Int_Buf, InData%%%s%s, ErrStat2, ErrMsg2, .TRUE. ) ! %s \n", - r->type->module->nickname, fast_interface_type_shortname(nonick2), r->name, - dimstr(r->ndims), r->name); - } - - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"); - fprintf(fp, " IF (ErrStat >= AbortErrLev) RETURN\n\n"); - - fprintf(fp, " IF(ALLOCATED(Re_Buf)) THEN ! %s\n", r->name); - fprintf(fp, " Re_BufSz = Re_BufSz + SIZE( Re_Buf )\n"); - fprintf(fp, " DEALLOCATE(Re_Buf)\n"); - fprintf(fp, " END IF\n"); - - fprintf(fp, " IF(ALLOCATED(Db_Buf)) THEN ! %s\n", r->name); - fprintf(fp, " Db_BufSz = Db_BufSz + SIZE( Db_Buf )\n"); - fprintf(fp, " DEALLOCATE(Db_Buf)\n"); - fprintf(fp, " END IF\n"); - - fprintf(fp, " IF(ALLOCATED(Int_Buf)) THEN ! %s\n", r->name); - fprintf(fp, " Int_BufSz = Int_BufSz + SIZE( Int_Buf )\n"); - fprintf(fp, " DEALLOCATE(Int_Buf)\n"); - fprintf(fp, " END IF\n"); - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " END DO\n"); - } - - } else { // intrinsic data types - - // do all dimensions of arrays (no need for loop over i%d) - - sprintf(tmp2, "SIZE(InData%%%s)", r->name); - - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") || - !strcmp( r->type->mapsto, "REAL(SiKi)") ) { - fprintf(fp, " Re_BufSz = Re_BufSz + %s ! %s\n", (r->ndims>0) ? tmp2 : "1", r->name); - } - else if ( !strcmp( r->type->mapsto, "REAL(DbKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)")) { - fprintf(fp, " Db_BufSz = Db_BufSz + %s ! %s\n", (r->ndims>0) ? tmp2 : "1", r->name); - } - else if ( !strcmp( r->type->mapsto, "INTEGER(IntKi)") || - !strcmp( r->type->mapsto, "LOGICAL" ) ) { - fprintf(fp, " Int_BufSz = Int_BufSz + %s ! %s\n", (r->ndims>0) ? tmp2 : "1", r->name); - } - else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */{ - fprintf(fp, " Int_BufSz = Int_BufSz + %s*LEN(InData%%%s) ! %s\n", (r->ndims>0) ? tmp2 : "1", r->name, r->name); - } - /*else - { - fprintf(fp,"! missing buffer for %s\n",r->name ) ; - }*/ - } - - if (has_deferred_dim(r, 0)){ - fprintf(fp, " END IF\n"); - } - // fprintf(fp, "\n"); // space between variables - - - } - - // Allocate buffers - fprintf(fp, " IF ( Re_BufSz .GT. 0 ) THEN \n"); - fprintf(fp, " ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 )\n"); - fprintf(fp, " IF (ErrStat2 /= 0) THEN \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); - fprintf(fp, " END IF\n"); - - fprintf(fp, " IF ( Db_BufSz .GT. 0 ) THEN \n"); - fprintf(fp, " ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 )\n"); - fprintf(fp, " IF (ErrStat2 /= 0) THEN \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); - fprintf(fp, " END IF\n"); - - fprintf(fp, " IF ( Int_BufSz .GT. 0 ) THEN \n"); - fprintf(fp, " ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 )\n"); - fprintf(fp, " IF (ErrStat2 /= 0) THEN \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); - fprintf(fp, " END IF\n"); - fprintf(fp, " IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them)\n\n"); - - if (sw_ccode) { - fprintf(fp, " IF (C_ASSOCIATED(InData%%C_obj%%object)) "); - fprintf(fp, "CALL SetErrStat(ErrID_Severe,'C_obj%%object cannot be packed.',ErrStat,ErrMsg,RoutineName)\n\n"); - } - - - fprintf(fp, " Re_Xferred = 1\n"); - fprintf(fp, " Db_Xferred = 1\n"); - fprintf(fp, " Int_Xferred = 1\n\n"); - - - // Pack data - for ( r = q->fields ; r ; r = r->next ) - { - - if (has_deferred_dim(r, 0)) { - // store whether the data type is allocated and the bounds of each dimension - fprintf(fp, " IF ( .NOT. %s(InData%%%s) ) THEN\n", assoc_or_allocated(r), r->name); - fprintf(fp, " IntKiBuf( Int_Xferred ) = 0\n"); // not allocated - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - //fprintf(fp, " IntKiBuf( Int_Xferred:Int_Xferred+2*%d-1 ) = 0\n", r->ndims, r->name); - //fprintf(fp, " Int_Xferred = Int_Xferred + 2*%d\n", r->ndims); - fprintf(fp, " ELSE\n"); - fprintf(fp, " IntKiBuf( Int_Xferred ) = 1\n"); // allocated - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - for (d = 1; d <= r->ndims; d++) { - fprintf(fp, " IntKiBuf( Int_Xferred ) = LBOUND(InData%%%s,%d)\n", r->name, d); - fprintf(fp, " IntKiBuf( Int_Xferred + 1) = UBOUND(InData%%%s,%d)\n", r->name, d); - fprintf(fp, " Int_Xferred = Int_Xferred + 2\n"); - } - fprintf(fp, "\n"); - strcpy(mainIndent, " "); - } - else { - strcpy(mainIndent, ""); - } - - - if (!strcmp(r->type->name, "meshtype") || - !strcmp(r->type->name, "dll_type") || - (r->type->type_type == DERIVED)) { // call individual routines to pack data from subtypes: - - if (frst == 1) { - fprintf(fp, " ! Allocate buffers for subtypes, if any (we'll get sizes from these) \n"); frst = 0; - } - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " DO i%d = LBOUND(InData%%%s,%d), UBOUND(InData%%%s,%d)\n", d, r->name, d, r->name, d); - } - - if (!strcmp(r->type->name, "meshtype")) { - fprintf(fp, " CALL MeshPack( InData%%%s%s, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! %s \n", - r->name, dimstr(r->ndims), r->name); - } - else if (!strcmp(r->type->name, "dll_type")) { - fprintf(fp, " CALL DLLTypePack( InData%%%s%s, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! %s \n", - r->name, dimstr(r->ndims), r->name); - } - else if (r->type->type_type == DERIVED) { // && ! r->type->usefrom ) { - remove_nickname(r->type->module->nickname, r->type->name, nonick2); - fprintf(fp, " CALL %s_Pack%s( Re_Buf, Db_Buf, Int_Buf, InData%%%s%s, ErrStat2, ErrMsg2, OnlySize ) ! %s \n", - r->type->module->nickname, fast_interface_type_shortname(nonick2), r->name, - dimstr(r->ndims),r->name); - } - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"); - fprintf(fp, " IF (ErrStat >= AbortErrLev) RETURN\n\n"); - - fprintf(fp, " IF(ALLOCATED(Re_Buf)) THEN\n"); - fprintf(fp, " IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf\n"); - fprintf(fp, " Re_Xferred = Re_Xferred + SIZE(Re_Buf)\n"); - fprintf(fp, " DEALLOCATE(Re_Buf)\n"); - fprintf(fp, " ELSE\n"); - fprintf(fp, " IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " ENDIF\n"); - - fprintf(fp, " IF(ALLOCATED(Db_Buf)) THEN\n"); - fprintf(fp, " IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf\n"); - fprintf(fp, " Db_Xferred = Db_Xferred + SIZE(Db_Buf)\n"); - fprintf(fp, " DEALLOCATE(Db_Buf)\n"); - fprintf(fp, " ELSE\n"); - fprintf(fp, " IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " ENDIF\n"); - - fprintf(fp, " IF(ALLOCATED(Int_Buf)) THEN\n"); - fprintf(fp, " IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf\n"); - fprintf(fp, " Int_Xferred = Int_Xferred + SIZE(Int_Buf)\n"); - fprintf(fp, " DEALLOCATE(Int_Buf)\n"); - fprintf(fp, " ELSE\n"); - fprintf(fp, " IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " ENDIF\n"); - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " END DO\n"); - } - - } - else { - // intrinsic data types - // do all dimensions of arrays (no need for loop over i%d) - - strcpy(indent, " "); - strcat(indent, mainIndent); - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, "%s DO i%d = LBOUND(InData%%%s,%d), UBOUND(InData%%%s,%d)\n", indent, d, r->name, d, r->name, d); - strcat(indent, " "); //create an indent - } - - - if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)")) { - fprintf(fp, "%s ReKiBuf(Re_Xferred) = InData%%%s%s\n", indent, r->name, dimstr(r->ndims)); - fprintf(fp, "%s Re_Xferred = Re_Xferred + 1\n", indent); - } - else if (!strcmp(r->type->mapsto, "REAL(DbKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)")) { - fprintf(fp, "%s DbKiBuf(Db_Xferred) = InData%%%s%s\n", indent, r->name, dimstr(r->ndims)); - fprintf(fp, "%s Db_Xferred = Db_Xferred + 1\n", indent); - } - else if (!strcmp(r->type->mapsto, "INTEGER(IntKi)") ) { - fprintf(fp, "%s IntKiBuf(Int_Xferred) = InData%%%s%s\n", indent, r->name, dimstr(r->ndims)); - fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); - } - else if (!strcmp(r->type->mapsto, "LOGICAL") ) { - fprintf(fp, "%s IntKiBuf(Int_Xferred) = TRANSFER(InData%%%s%s, IntKiBuf(1))\n", indent, r->name, dimstr(r->ndims)); - fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); - } - - else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */{ - - fprintf(fp, "%s DO I = 1, LEN(InData%%%s)\n", indent, r->name); - fprintf(fp, "%s IntKiBuf(Int_Xferred) = ICHAR(InData%%%s%s(I:I), IntKi)\n", indent, r->name, dimstr(r->ndims)); - fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); - fprintf(fp, "%s END DO ! I\n", indent); - - } - - for (d = r->ndims; d >= 1; d--) { - strcpy(indent, " "); - strcat(indent, mainIndent); - for (i = 1; i < d; i++) { - strcat(indent, " "); - } - fprintf(fp, "%s END DO\n", indent); - } - - } - - if (has_deferred_dim(r, 0)){ - fprintf(fp, " END IF\n"); - } - } - - fprintf(fp," END SUBROUTINE %s_Pack%s\n\n", ModName->nickname,nonick ) ; - return;//(0) ; -} - -void -gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) -{ - char tmp[NAMELEN], tmp2[NAMELEN], indent[NAMELEN], addnick[NAMELEN], nonick[NAMELEN], nonick2[NAMELEN], mainIndent[6]; - node_t *q, * r ; - int d, i ; - - remove_nickname(ModName->nickname,inout,nonick) ; - append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; -// sprintf(tmp,"%s_%s",ModName->nickname,inoutlong) ; -// sprintf(tmp,"%s",inoutlong) ; - sprintf(tmp,"%s",addnick) ; - if (( q = get_entry( make_lower_temp(tmp),ModName->module_ddt_list ) ) == NULL ) - { - fprintf(stderr,"Registry warning: generating %s_UnPack%s: cannot find definition for %s\n",ModName->nickname,nonick,tmp) ; - return;//(1) ; - } - - fprintf(fp," SUBROUTINE %s_UnPack%s( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg )\n", ModName->nickname,nonick ) ; - fprintf(fp," REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:)\n") ; - fprintf(fp," REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:)\n") ; - fprintf(fp," INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:)\n") ; - fprintf(fp," TYPE(%s), INTENT(INOUT) :: OutData\n",addnick ) ; - fprintf(fp," INTEGER(IntKi), INTENT( OUT) :: ErrStat\n") ; - fprintf(fp," CHARACTER(*), INTENT( OUT) :: ErrMsg\n") ; - fprintf(fp," ! Local variables\n") ; - fprintf(fp," INTEGER(IntKi) :: Buf_size\n") ; - fprintf(fp," INTEGER(IntKi) :: Re_Xferred\n") ; - fprintf(fp," INTEGER(IntKi) :: Db_Xferred\n") ; - fprintf(fp," INTEGER(IntKi) :: Int_Xferred\n") ; - fprintf(fp," INTEGER(IntKi) :: i\n") ; - for (d = 1; d <= q->max_ndims; d++){ - fprintf(fp," INTEGER(IntKi) :: i%d, i%d_l, i%d_u ! bounds (upper/lower) for an array dimension %d\n", d, d, d, d); - } - fprintf(fp, " INTEGER(IntKi) :: ErrStat2\n"); - fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2\n"); - fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_UnPack%s'\n", ModName->nickname, nonick); - - fprintf(fp," ! buffers to store meshes, if any\n") ; - fprintf(fp," REAL(ReKi), ALLOCATABLE :: Re_Buf(:)\n") ; - fprintf(fp," REAL(DbKi), ALLOCATABLE :: Db_Buf(:)\n") ; - fprintf(fp," INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:)\n") ; - fprintf(fp," !\n") ; - fprintf(fp," ErrStat = ErrID_None\n") ; - fprintf(fp," ErrMsg = \"\"\n") ; - fprintf(fp," Re_Xferred = 1\n") ; - fprintf(fp," Db_Xferred = 1\n") ; - fprintf(fp," Int_Xferred = 1\n") ; - - -// BJJ: TODO: if there are C types, we're going to have to associate with C data structures.... - - // Unpack data - for (r = q->fields; r; r = r->next) - { - - strcpy(tmp, ""); - if (has_deferred_dim(r, 0)){ - // determine if the array was allocated when packed: - fprintf(fp, " IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! %s not allocated\n", r->name); // not allocated - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - //fprintf(fp, " Int_Xferred = Int_Xferred + 2*%d\n", r->ndims); - fprintf(fp, " ELSE\n"); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - - for (d = 1; d <= r->ndims; d++) { - fprintf(fp, " i%d_l = IntKiBuf( Int_Xferred )\n", d); //fprintf(fp, " IntKiBuf( Int_Xferred ) = LBOUND(OutData%%%s,%d)\n", r->name, d); - fprintf(fp, " i%d_u = IntKiBuf( Int_Xferred + 1)\n", d); //fprintf(fp, " IntKiBuf( Int_Xferred + 1) = UBOUND(OutData%%%s,%d)\n", r->name, d); - fprintf(fp, " Int_Xferred = Int_Xferred + 2\n"); - sprintf(tmp2, ",i%d_l:i%d_u", d, d); - strcat(tmp, tmp2); - } - - fprintf(fp, " IF (%s(OutData%%%s)) DEALLOCATE(OutData%%%s)\n", assoc_or_allocated(r), r->name, r->name); // BJJ: need NULLIFY(), too? - fprintf(fp, " ALLOCATE(OutData%%%s(%s),STAT=ErrStat2)\n", r->name, (char*)&(tmp[1])); - fprintf(fp, " IF (ErrStat2 /= 0) THEN \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%%%s.', ErrStat, ErrMsg,RoutineName)\n", r->name); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); - - if (sw_ccode && is_pointer(r)) { // bjj: this needs to be updated if we've got multiple dimension arrays - fprintf(fp, " OutData%%c_obj%%%s_Len = SIZE(OutData%%%s)\n", r->name, r->name); - fprintf(fp, " IF (OutData%%c_obj%%%s_Len > 0) &\n", r->name); - - fprintf(fp, " OutData%%c_obj%%%s = C_LOC( OutData%%%s(", r->name,r->name); - for (d = 1; d <= r->ndims; d++) { - fprintf(fp, " i%d_l", d); - if (d < r->ndims) { fprintf(fp, ","); } - } - fprintf(fp, " ) )\n"); - - } - strcpy(mainIndent, " "); - } - else{ - for (d = 1; d <= r->ndims; d++) { - fprintf(fp, " i%d_l = LBOUND(OutData%%%s,%d)\n", d, r->name, d); - fprintf(fp, " i%d_u = UBOUND(OutData%%%s,%d)\n", d, r->name, d); - sprintf(tmp2, ",i%d_l:i%d_u", d, d); - strcat(tmp, tmp2); - } - strcpy(mainIndent, ""); - } - - if (!strcmp(r->type->name, "meshtype") || - !strcmp(r->type->name, "dll_type") || - (r->type->type_type == DERIVED)) { // call individual routines to pack data from subtypes: - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " DO i%d = LBOUND(OutData%%%s,%d), UBOUND(OutData%%%s,%d)\n", d, r->name, d, r->name, d); - } - - // initialize buffers to send to subtype-unpack routines: - // reals: - fprintf(fp, " Buf_size=IntKiBuf( Int_Xferred )\n"); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " IF(Buf_size > 0) THEN\n"); - fprintf(fp, " ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2)\n"); - fprintf(fp, " IF (ErrStat2 /= 0) THEN \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); - - fprintf(fp, " Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 )\n"); - fprintf(fp, " Re_Xferred = Re_Xferred + Buf_size\n"); - fprintf(fp, " END IF\n"); - - // doubles: - fprintf(fp, " Buf_size=IntKiBuf( Int_Xferred )\n"); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " IF(Buf_size > 0) THEN\n"); - fprintf(fp, " ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2)\n"); - fprintf(fp, " IF (ErrStat2 /= 0) THEN \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); - - fprintf(fp, " Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 )\n"); - fprintf(fp, " Db_Xferred = Db_Xferred + Buf_size\n"); - fprintf(fp, " END IF\n"); - - // integers: - fprintf(fp, " Buf_size=IntKiBuf( Int_Xferred )\n"); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " IF(Buf_size > 0) THEN\n"); - fprintf(fp, " ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2)\n"); - fprintf(fp, " IF (ErrStat2 /= 0) THEN \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); - - fprintf(fp, " Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 )\n"); - fprintf(fp, " Int_Xferred = Int_Xferred + Buf_size\n"); - fprintf(fp, " END IF\n"); - - - if (!strcmp(r->type->name, "meshtype")) { - fprintf(fp, " CALL MeshUnpack( OutData%%%s%s, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! %s \n", - r->name, dimstr(r->ndims), r->name); - } - else if (!strcmp(r->type->name, "dll_type")) { - fprintf(fp, " CALL DLLTypeUnpack( OutData%%%s%s, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! %s \n", - r->name, dimstr(r->ndims), r->name); - } - else if (r->type->type_type == DERIVED) { // && ! r->type->usefrom ) { - remove_nickname(r->type->module->nickname, r->type->name, nonick2); - fprintf(fp, " CALL %s_Unpack%s( Re_Buf, Db_Buf, Int_Buf, OutData%%%s%s, ErrStat2, ErrMsg2 ) ! %s \n", - r->type->module->nickname, fast_interface_type_shortname(nonick2), r->name, - dimstr(r->ndims), r->name); - } - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"); - fprintf(fp, " IF (ErrStat >= AbortErrLev) RETURN\n\n"); - - fprintf(fp, " IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf )\n"); - fprintf(fp, " IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf )\n"); - fprintf(fp, " IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf)\n"); - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " END DO\n"); - } - - } - else - { - strcpy(indent, " "); - strcat(indent, mainIndent); - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, "%s DO i%d = LBOUND(OutData%%%s,%d), UBOUND(OutData%%%s,%d)\n", indent, d, r->name, d, r->name, d); - strcat(indent, " "); //create an indent - } - - - if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)")) { - if (sw_ccode && is_pointer(r)) { - fprintf(fp, "%s OutData%%%s%s = REAL(ReKiBuf(Re_Xferred), C_FLOAT)\n", indent, r->name, dimstr(r->ndims)); - } - else if (!strcmp(r->type->mapsto, "REAL(SiKi)")) { - fprintf(fp, "%s OutData%%%s%s = REAL(ReKiBuf(Re_Xferred), SiKi)\n", indent, r->name, dimstr(r->ndims)); - } - else { - fprintf(fp, "%s OutData%%%s%s = ReKiBuf(Re_Xferred)\n", indent, r->name, dimstr(r->ndims)); - } - fprintf(fp, "%s Re_Xferred = Re_Xferred + 1\n", indent); - } - else if (!strcmp(r->type->mapsto, "REAL(DbKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)")) { - if (sw_ccode && is_pointer(r)) { - fprintf(fp, "%s OutData%%%s%s = REAL(DbKiBuf(Db_Xferred), C_DOUBLE)\n", indent, r->name, dimstr(r->ndims)); - } - else if (!strcmp(r->type->mapsto, "REAL(R8Ki)")) { - fprintf(fp, "%s OutData%%%s%s = REAL(DbKiBuf(Db_Xferred), R8Ki)\n", indent, r->name, dimstr(r->ndims)); - } - else { - fprintf(fp, "%s OutData%%%s%s = DbKiBuf(Db_Xferred)\n", indent, r->name, dimstr(r->ndims)); - } - fprintf(fp, "%s Db_Xferred = Db_Xferred + 1\n", indent); - } - else if (!strcmp(r->type->mapsto, "INTEGER(IntKi)")) { - fprintf(fp, "%s OutData%%%s%s = IntKiBuf(Int_Xferred)\n", indent, r->name, dimstr(r->ndims)); - fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); - } - else if (!strcmp(r->type->mapsto, "LOGICAL")) { - fprintf(fp, "%s OutData%%%s%s = TRANSFER(IntKiBuf(Int_Xferred), OutData%%%s%s)\n", indent, r->name, dimstr(r->ndims), r->name, dimstr(r->ndims)); - fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); - } - - else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */ { - - fprintf(fp, "%s DO I = 1, LEN(OutData%%%s)\n", indent, r->name); - fprintf(fp, "%s OutData%%%s%s(I:I) = CHAR(IntKiBuf(Int_Xferred))\n", indent, r->name, dimstr(r->ndims)); - fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); - fprintf(fp, "%s END DO ! I\n", indent); - - } - - for (d = r->ndims; d >= 1; d--) { - strcpy(indent, " "); - strcat(indent, mainIndent); - for (i = 1; i < d; i++) { - strcat(indent, " "); - } - fprintf(fp, "%s END DO\n", indent); - } - -// need to move scalars and strings to the %c_obj% type, too! -// compare with copy routine - - if (sw_ccode && !is_pointer(r) && r->ndims == 0) { - if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)") || - !strcmp(r->type->mapsto, "REAL(DbKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)") || - !strcmp(r->type->mapsto, "INTEGER(IntKi)") || - !strcmp(r->type->mapsto, "LOGICAL")) - { - fprintf(fp, " OutData%%C_obj%%%s = OutData%%%s\n", r->name, r->name); - } - else { // characters need to be copied differently - fprintf(fp, " OutData%%C_obj%%%s = TRANSFER(OutData%%%s, OutData%%C_obj%%%s )\n", r->name, r->name, r->name); - } - } - - } - - if (has_deferred_dim(r, 0)){ - fprintf(fp, " END IF\n"); - } - } - - fprintf(fp," END SUBROUTINE %s_UnPack%s\n\n", ModName->nickname,nonick ) ; - return;//(0) ; -} - -void -gen_mask_alloc( FILE *fp, int ndims, char *tmp ) -{ - if ( ndims == 1 ) { - fprintf(fp," ALLOCATE(mask%d(SIZE(%s,1)))\n mask%d = .TRUE.\n",ndims,tmp,ndims) ; - } else if ( ndims == 2 ) { - fprintf(fp," ALLOCATE(mask%d(SIZE(%s,1),SIZE(%s,2)))\n mask%d = .TRUE.\n",ndims,tmp,tmp,ndims) ; - } else if ( ndims == 3 ) { - fprintf(fp," ALLOCATE(mask%d(SIZE(%s,1),SIZE(%s,2),SIZE(%s,3)))\n mask%d = .TRUE.\n",ndims,tmp,tmp,tmp,ndims) ; - } else if ( ndims == 4 ) { - fprintf(fp," ALLOCATE(mask%d(SIZE(%s,1),SIZE(%s,2),SIZE(%s,3),SIZE(%s,4)))\n mask%d = .TRUE.\n",ndims,tmp,tmp,tmp,tmp,ndims) ; - } else if ( ndims == 5 ) { - fprintf(fp," ALLOCATE(mask%d(SIZE(%s,1),SIZE(%s,2),SIZE(%s,3),SIZE(%s,4),SIZE(%s,5)))\n mask%d = .TRUE.\n",ndims,tmp,tmp,tmp,tmp,tmp,ndims) ; - } -} - - - -int -gen_destroy( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) -{ - char tmp[NAMELEN], addnick[NAMELEN], nonick[NAMELEN] ; - node_t *q, * r ; - int d ; - - remove_nickname(ModName->nickname,inout,nonick) ; - append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; - fprintf(fp, " SUBROUTINE %s_Destroy%s( %sData, ErrStat, ErrMsg, DEALLOCATEpointers )\n",ModName->nickname,nonick,nonick ); - fprintf(fp, " TYPE(%s), INTENT(INOUT) :: %sData\n",addnick,nonick) ; - fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n") ; - fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"); - fprintf(fp, " LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers\n"); - fprintf(fp, " \n"); - fprintf(fp, " INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 \n"); - fprintf(fp, " LOGICAL :: DEALLOCATEpointers_local\n"); - fprintf(fp, " INTEGER(IntKi) :: ErrStat2\n"); - fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2\n"); - fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_Destroy%s'\n\n", ModName->nickname, nonick); - fprintf(fp, " ErrStat = ErrID_None\n"); - fprintf(fp, " ErrMsg = \"\"\n\n"); - fprintf(fp, " IF (PRESENT(DEALLOCATEpointers)) THEN\n"); - fprintf(fp, " DEALLOCATEpointers_local = DEALLOCATEpointers\n"); - fprintf(fp, " ELSE\n"); - fprintf(fp, " DEALLOCATEpointers_local = .true.\n"); - fprintf(fp, " END IF\n"); - fprintf(fp," \n") ; - - -// sprintf(tmp,"%s_%s",ModName->nickname,inoutlong) ; -// sprintf(tmp,"%s",inoutlong) ; - sprintf(tmp,"%s",addnick) ; - if (( q = get_entry( make_lower_temp(tmp),ModName->module_ddt_list ) ) == NULL ) - { - fprintf(stderr,"Registry warning: generating %s_Destroy%s: cannot find definition for %s\n",ModName->nickname,nonick,tmp) ; - } else { - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type == NULL ) { - fprintf(stderr,"Registry warning generating %s_Destroy%s: %s has no type.\n",ModName->nickname,nonick,r->name) ; - } else { - - if ( r->ndims > 0 && has_deferred_dim(r,0) ) { - fprintf(fp,"IF (%s(%sData%%%s)) THEN\n",assoc_or_allocated(r),nonick,r->name) ; - } - - if (r->type->type_type == DERIVED){ - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, "DO i%d = LBOUND(%sData%%%s,%d), UBOUND(%sData%%%s,%d)\n", d, nonick, r->name, d, nonick, r->name, d); - } - - if (!strcmp(r->type->name, "meshtype")) { - fprintf(fp, " CALL MeshDestroy( %sData%%%s%s, ErrStat2, ErrMsg2 )\n", nonick, r->name, dimstr(r->ndims)); - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"); - } - else if (!strcmp(r->type->name, "dll_type")) { - fprintf(fp, " CALL FreeDynamicLib( %sData%%%s%s, ErrStat2, ErrMsg2 )\n", nonick, r->name, dimstr(r->ndims)); - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"); - - } - else { //if (r->type->type_type == DERIVED) { // && ! r->type->usefrom ) { - char nonick2[NAMELEN]; - remove_nickname(r->type->module->nickname, r->type->name, nonick2); - fprintf(fp, " CALL %s_Destroy%s( %sData%%%s%s, ErrStat2, ErrMsg2, DEALLOCATEpointers_local )\n", - r->type->module->nickname, fast_interface_type_shortname(nonick2), nonick, r->name, dimstr(r->ndims)); - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"); - } - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, "ENDDO\n"); - } - } - if ( r->ndims > 0 && has_deferred_dim(r,0) ) { - if (is_pointer(r)) { - fprintf(fp, " IF (DEALLOCATEpointers_local) &\n"); - } - fprintf(fp," DEALLOCATE(%sData%%%s)\n",nonick,r->name) ; - if ( is_pointer(r) ) { - fprintf(fp, " %sData%%%s => NULL()\n",nonick,r->name) ; - if (sw_ccode){ - fprintf(fp, " %sData%%C_obj%%%s = C_NULL_PTR\n", nonick, r->name); - fprintf(fp, " %sData%%C_obj%%%s_Len = 0\n", nonick, r->name); - } - } - fprintf(fp,"ENDIF\n") ; - } - - - } - } - } - - fprintf(fp," END SUBROUTINE %s_Destroy%s\n\n", ModName->nickname,nonick ) ; - return(0) ; -} - - -#define MAXRECURSE 9 -// HERE -#if 0 -void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, const int order, node_t *r, char * deref, int recurselevel) { - node_t *q, *r1 ; - int j ; - int mesh = 0 ; - char derefrecurse[NAMELEN],tmp[NAMELEN] ; - if ( recurselevel > MAXRECURSE ) { - fprintf(stderr,"REGISTRY ERROR: too many levels of array subtypes\n") ; - exit(9) ; - } - if ( r->type != NULL ) { - -// check if this is an allocatable array: - if ( r->ndims > 0 && has_deferred_dim(r,0) ) { - fprintf(fp,"IF (%s(%s_out%s%%%s) .AND. %s(%s(1)%s%%%s)) THEN\n",assoc_or_allocated(r),uy,deref,r->name, - assoc_or_allocated(r), uy, deref, r->name); - } - if ( r->type->type_type == DERIVED ) { - if (( q = get_entry( make_lower_temp(r->type->name),ModName->module_ddt_list ) ) != NULL ) { - for ( r1 = q->fields ; r1 ; r1 = r1->next ) - { - sprintf(derefrecurse,"%s%%%s",deref,r->name) ; - for ( j = r->ndims ; j > 0 ; j-- ) { - - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s,%d),UBOUND(%s_out%s,%d)\n", recurselevel, j, uy, derefrecurse, j, uy, derefrecurse, j); - sprintf(derefrecurse,"%s%%%s(i%d%d)",deref,r->name,recurselevel,j) ; - } - gen_extint_order( fp, ModName, typnm, uy, order, r1, derefrecurse, recurselevel+1 ) ; - for ( j = r->ndims ; j > 0 ; j-- ) { - fprintf(fp," ENDDO\n") ; - } - } - } else if ( !strcmp( r->type->mapsto, "MeshType" ) ) { - for ( j = r->ndims ; j > 0 ; j-- ) { - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", 0, j, uy, deref, r->name, j, uy, deref, r->name, j); - } - - if ( order == 0 ) { - fprintf(fp, " CALL MeshCopy(%s(1)%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dimstr(r->ndims) - , uy, deref, r->name, dimstr(r->ndims)); - } else if ( order == 1 ) { - fprintf(fp," CALL MeshExtrapInterp1(%s(1)%s%%%s%s, %s(2)%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } else if ( order == 2 ) { - fprintf(fp," CALL MeshExtrapInterp2(%s(1)%s%%%s%s, %s(2)%s%%%s%s, %s(3)%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " IF (ErrStat>=AbortErrLev) RETURN\n"); - - for ( j = r->ndims ; j > 0 ; j-- ) { - fprintf(fp," ENDDO\n") ; - } - } else { - - - char nonick2[NAMELEN] ; - remove_nickname(r->type->module->nickname,r->type->name,nonick2) ; - strcpy(dimstr(r->ndims),"") ; - for ( j = r->ndims ; j >= 1 ; j-- ) { - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d), UBOUND(%s_out%s%%%s,%d)\n", 0, j, uy, deref, r->name, j, uy, deref, r->name, j); - if ( j == r->ndims ) strcat(dimstr(r->ndims),"(") ; - sprintf(tmp,"i%d%d",0,j) ; - if ( j == 1 ) strcat(tmp,")") ; else strcat(tmp,",") ; - strcat(dimstr(r->ndims),tmp) ; - } - - - fprintf(fp," CALL %s_%s_ExtrapInterp( %s%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n", - r->type->module->nickname,fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - fprintf(fp," CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp," IF (ErrStat>=AbortErrLev) RETURN\n"); - - - for ( j = r->ndims ; j >= 1 ; j-- ) { - fprintf(fp," ENDDO\n") ; - } - - } - } else if ( !strcmp( r->type->mapsto, "REAL(ReKi)") || - !strcmp( r->type->mapsto, "REAL(SiKi)") || - !strcmp( r->type->mapsto, "REAL(DbKi)") ) { - if ( r->ndims==0 ) { - } else if ( r->ndims==1 && order > 0 ) { - fprintf(fp, " ALLOCATE(b1(SIZE(%s_out%s%%%s,1)))\n", uy, deref, r->name); - fprintf(fp, " ALLOCATE(c1(SIZE(%s_out%s%%%s,1)))\n", uy, deref, r->name); - } else if ( r->ndims==2 && order > 0 ) { - fprintf(fp, " ALLOCATE(b2(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2) ))\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " ALLOCATE(c2(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2) ))\n", uy, deref, r->name, uy, deref, r->name); - } else if ( r->ndims==3 && order > 0 ) { - fprintf(fp, " ALLOCATE(b3(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3) ))\n", uy, deref, r->name); - fprintf(fp, " ALLOCATE(c3(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3) ))\n", uy, deref, r->name); - } else if ( r->ndims==4 && order > 0 ) { - fprintf(fp, " ALLOCATE(b4(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4) ))\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " ALLOCATE(c4(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4) ))\n", uy, deref, r->name, uy, deref, r->name); - } else if ( r->ndims==5 && order > 0 ) { - fprintf(fp, " ALLOCATE(b5(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,5) ))\n", uy, deref, r->name); - fprintf(fp, " ALLOCATE(c5(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,5) ))\n", uy, deref, r->name); - } else { - if (order > 0) fprintf(stderr, "Registry WARNING: too many dimensions for %s%%%s\n", deref, r->name); - } - - if ( order == 0 ) { - fprintf(fp, " %s_out%s%%%s = %s(1)%s%%%s\n", uy, deref, r->name, uy, deref, r->name); - } else if ( order == 1 ) { - fprintf(fp, " b%d = -(%s(1)%s%%%s - %s(2)%s%%%s)/t(2)\n", r->ndims, uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " %s_out%s%%%s = %s(1)%s%%%s + b%d * t_out\n", uy, deref, r->name, uy, deref, r->name, r->ndims); - } else if ( order == 2 ) { - fprintf(fp," b%d = (t(3)**2*(%s(1)%s%%%s - %s(2)%s%%%s) + t(2)**2*(-%s(1)%s%%%s + %s(3)%s%%%s))/(t(2)*t(3)*(t(2) - t(3)))\n", - r->ndims, uy, deref, r->name, uy, deref, r->name, uy, deref, r->name, uy, deref, r->name); - fprintf(fp," c%d = ( (t(2)-t(3))*%s(1)%s%%%s + t(3)*%s(2)%s%%%s - t(2)*%s(3)%s%%%s ) / (t(2)*t(3)*(t(2) - t(3)))\n", - r->ndims, uy, deref, r->name, uy, deref, r->name, uy, deref, r->name); - fprintf(fp," %s_out%s%%%s = %s(1)%s%%%s + b%d * t_out + c%d * t_out**2\n" - , uy, deref, r->name, uy, deref, r->name, r->ndims, r->ndims); - } - if ( r->ndims>=1 && order > 0 ) { - fprintf(fp," DEALLOCATE(b%d)\n",r->ndims) ; - fprintf(fp," DEALLOCATE(c%d)\n",r->ndims) ; - } - } -// check if this is an allocatable array: - if ( r->ndims > 0 && has_deferred_dim(r,0) ) { - fprintf(fp,"END IF ! check if allocated\n") ; - } - - } -} -#endif -void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, const int order, node_t *r, char * deref, int recurselevel) { - node_t *q, *r1; - int i, j; - int mesh = 0; - char derefrecurse[NAMELEN], indent[NAMELEN], tmp[NAMELEN]; - if (recurselevel > MAXRECURSE) { - fprintf(stderr, "REGISTRY ERROR: too many levels of array subtypes\n"); - exit(9); - } - if (r->type != NULL) { - - // check if this is an allocatable array: - if (r->ndims > 0 && has_deferred_dim(r, 0)) { - fprintf(fp, "IF (%s(%s_out%s%%%s) .AND. %s(%s1%s%%%s)) THEN\n", assoc_or_allocated(r), uy, deref, r->name, - assoc_or_allocated(r), uy, deref, r->name); - } - if (r->type->type_type == DERIVED) { - - if ((q = get_entry(make_lower_temp(r->type->name), ModName->module_ddt_list)) != NULL) { - for (r1 = q->fields; r1; r1 = r1->next) - { - sprintf(derefrecurse, "%s%%%s", deref, r->name); - - for (j = r->ndims; j > 0; j--) { - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s,%d),UBOUND(%s_out%s,%d)\n", recurselevel, j, uy, derefrecurse, j, uy, derefrecurse, j); - } - - - if (r->ndims > 0) { - strcat(derefrecurse, "("); - for (j = 1; j <= r->ndims; j++) { - sprintf(tmp, "i%d%d", recurselevel, j); - strcat(derefrecurse, tmp); - if (j < r->ndims) { - strcat(derefrecurse, ","); - } - } - strcat(derefrecurse, ")"); - } - - gen_extint_order(fp, ModName, typnm, uy, order, r1, derefrecurse, recurselevel + 1); - for (j = r->ndims; j > 0; j--) { - fprintf(fp, " ENDDO\n"); - } - } - } - - else { - - for (j = r->ndims; j > 0; j--) { - fprintf(fp, " DO i%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", j, uy, deref, r->name, j, uy, deref, r->name, j); - } - - if (!strcmp(r->type->mapsto, "MeshType")) { - if (order == 0) { - fprintf(fp, " CALL MeshCopy(%s1%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dimstr(r->ndims) - , uy, deref, r->name, dimstr(r->ndims)); - } - else if (order == 1) { - fprintf(fp, " CALL MeshExtrapInterp1(%s1%s%%%s%s, %s2%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } - else if (order == 2) { - fprintf(fp, " CALL MeshExtrapInterp2(%s1%s%%%s%s, %s2%s%%%s%s, %s3%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } - } - else { - char nonick2[NAMELEN]; - remove_nickname(r->type->module->nickname, r->type->name, nonick2); - - if (order == 0) { - fprintf(fp, " CALL %s_Copy%s(%s1%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", r->type->module->nickname, fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } - else if (order == 1) { - fprintf(fp, " CALL %s_%s_ExtrapInterp1( %s1%s%%%s%s, %s2%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n", - r->type->module->nickname, fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } - else if (order == 2) { - fprintf(fp, " CALL %s_%s_ExtrapInterp2( %s1%s%%%s%s, %s2%s%%%s%s, %s3%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n", - r->type->module->nickname, fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } - } - - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); - //fprintf(fp, " IF (ErrStat>=AbortErrLev) RETURN\n"); - for (j = r->ndims; j >= 1; j--) { - fprintf(fp, " ENDDO\n"); - } - - } - } - else if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)") || - !strcmp(r->type->mapsto, "REAL(DbKi)")) { - - - if (order == 0) { - //bjj: this should probably have some "IF ALLOCATED" statements around it, but we're just calling - // the copy routine - fprintf(fp, " %s_out%s%%%s = %s1%s%%%s\n", uy, deref, r->name, uy, deref, r->name); - } - else - strcpy(indent, ""); - for (j = r->ndims; j > 0; j--) { - fprintf(fp, "%s DO i%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", indent, j, uy, deref, r->name, j, uy, deref, r->name, j); - strcat(indent, " "); //create an indent - } - - if (order == 1) { - if (r->gen_periodic) { - fprintf(fp, "%s CALL Angles_ExtrapInterp( %s1%s%%%s%s, %s2%s%%%s%s, tin, %s_out%s%%%s%s, tin_out )\n", - indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } - else { - fprintf(fp, "%s b = -(%s1%s%%%s%s - %s2%s%%%s%s)\n", indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - fprintf(fp, "%s %s_out%s%%%s%s = %s1%s%%%s%s + b * ScaleFactor\n", indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - }; - } - if (order == 2) { - if (r->gen_periodic) { - fprintf(fp, "%s CALL Angles_ExtrapInterp( %s1%s%%%s%s, %s2%s%%%s%s, %s3%s%%%s%s, tin, %s_out%s%%%s%s, tin_out )\n", - indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } - else { - fprintf(fp, "%s b = (t(3)**2*(%s1%s%%%s%s - %s2%s%%%s%s) + t(2)**2*(-%s1%s%%%s%s + %s3%s%%%s%s))* scaleFactor\n", - indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - fprintf(fp, "%s c = ( (t(2)-t(3))*%s1%s%%%s%s + t(3)*%s2%s%%%s%s - t(2)*%s3%s%%%s%s ) * scaleFactor\n", - indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - fprintf(fp, "%s %s_out%s%%%s%s = %s1%s%%%s%s + b + c * t_out\n", - indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); - } - } - for (j = r->ndims; j >= 1; j--) { - strcpy(indent, ""); - for (i = 1; i < j; i++) { - strcat(indent, " "); - } - fprintf(fp, "%s END DO\n", indent); - } - } - // check if this is an allocatable array: - if (r->ndims > 0 && has_deferred_dim(r, 0)) { - fprintf(fp, "END IF ! check if allocated\n"); - } - } - -} // gen_extint_order - -void calc_extint_order(FILE *fp, const node_t *ModName, node_t *r, int recurselevel, int *max_ndims, int *max_nrecurs, int *max_alloc_ndims) { - node_t *q, *r1 ; -// bjj: make sure this is consistent with logic of gen_extint_order - - if ( r->type != NULL ) { - // if(r->ndims > *max_ndims )* max_ndims = r->ndims; - - if (r->type->type_type == DERIVED) { - if ((q = get_entry(make_lower_temp(r->type->name), ModName->module_ddt_list)) != NULL) { - for (r1 = q->fields; r1; r1 = r1->next) - { - if (r->ndims > 0) { - if (recurselevel > *max_nrecurs) *max_nrecurs = recurselevel; - if (r->ndims > *max_ndims ) *max_ndims = r->ndims; - } - calc_extint_order(fp, ModName, r1, recurselevel + 1, max_ndims, max_nrecurs, max_alloc_ndims); - } - } - else if (!strcmp(r->type->mapsto, "MeshType")) { - if (r->ndims > 0) { - if (r->ndims > *max_ndims)* max_ndims = r->ndims; - } - } - else { - if (r->ndims >= 1) { - if (r->ndims > *max_ndims)* max_ndims = r->ndims; - } - } - - } - else if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)") || - !strcmp(r->type->mapsto, "REAL(DbKi)")) { - if (/*order > 0 &&*/ r->ndims > *max_alloc_ndims) *max_alloc_ndims = r->ndims; - if (r->ndims > *max_ndims)* max_ndims = r->ndims; - } - - - } - - if ( recurselevel > MAXRECURSE ) { - fprintf(stderr,"REGISTRY ERROR: too many levels of array subtypes\n") ; - exit(9) ; - } - -} - -#if 0 -void -gen_ExtrapInterp( FILE *fp , const node_t * ModName, char * typnm, char * typnmlong ) -{ - char nonick[NAMELEN] ; - char *ddtname; char uy[2]; - node_t *q, * r ; - int i, j, max_ndims, max_nrecurs, max_alloc_ndims; - - if (!strcmp(make_lower_temp(typnm), "output")){ - strcpy(uy,"y"); - } - else{ - strcpy(uy, "u"); - } - - fprintf(fp,"\n") ; - fprintf(fp," SUBROUTINE %s_%s_ExtrapInterp(%s, tin, %s_out, tin_out, ErrStat, ErrMsg )\n",ModName->nickname,typnm,uy,uy) ; - fprintf(fp,"!\n") ; - fprintf(fp, "! This subroutine calculates a extrapolated (or interpolated) %s %s_out at time t_out, from previous/future time\n", typnm, uy); - fprintf(fp, "! values of %s (which has values associated with times in t). Order of the interpolation is given by the size of %s\n", uy, uy); - fprintf(fp,"!\n") ; - fprintf(fp,"! expressions below based on either\n") ; - fprintf(fp,"!\n") ; - fprintf(fp,"! f(t) = a\n") ; - fprintf(fp,"! f(t) = a + b * t, or\n") ; - fprintf(fp,"! f(t) = a + b * t + c * t**2\n") ; - fprintf(fp,"!\n") ; - fprintf(fp,"! where a, b and c are determined as the solution to\n") ; - fprintf(fp, "! f(t1) = %s1, f(t2) = %s2, f(t3) = %s3 (as appropriate)\n", uy, uy, uy); - fprintf(fp,"!\n") ; - fprintf(fp,"!..................................................................................................................................\n") ; - fprintf(fp,"\n") ; - - - fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s(:) ! %s at t1 > t2 > t3\n", ModName->nickname, typnmlong, uy, typnm); - fprintf(fp, " REAL(DbKi), INTENT(IN ) :: tin(:) ! Times associated with the %ss\n", typnm); -//jm Modified from INTENT( OUT) to INTENT(INOUT) to prevent ALLOCATABLE array arguments in the DDT -//jm from being maliciously deallocated through the call.See Sec. 5.1.2.7 of bonehead Fortran 2003 standard - fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", ModName->nickname, typnmlong, uy, typnm); - fprintf(fp," REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to\n") ; - fprintf(fp," INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n") ; - fprintf(fp," CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n") ; - fprintf(fp," ! local variables\n") ; - fprintf(fp, " REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the %ss\n", typnm); - fprintf(fp," REAL(DbKi) :: t_out ! Time to which to be extrap/interpd\n") ; - fprintf(fp," INTEGER(IntKi) :: order ! order of polynomial fit (max 2)\n") ; - fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_%s_ExtrapInterp'\n", ModName->nickname, typnm); - - max_ndims = 0; // ModName->module_ddt_list->max_ndims; //bjj: this is max for module, not for typnmlong - max_nrecurs = 0; // MAXRECURSE; - max_alloc_ndims = 0; - - for (q = ModName->module_ddt_list; q; q = q->next) - { - if (q->usefrom == 0) { - ddtname = q->name; - remove_nickname(ModName->nickname, ddtname, nonick); - if (!strcmp(nonick, make_lower_temp(typnmlong))) { - for (r = q->fields; r; r = r->next) - { - // recursive - calc_extint_order(fp, ModName, r, 0, &max_ndims, &max_nrecurs, &max_alloc_ndims); - } - } - } - } - //fprintf(stderr, "ndims=%d nrecurs=%d %d\n\n", max_ndims, max_nrecurs, max_alloc_ndims); - - if (max_alloc_ndims >= 0){ - fprintf(fp," REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation\n") ; - fprintf(fp," REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation\n") ; - if (max_alloc_ndims >= 1){ - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation\n") ; - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation\n") ; - if (max_alloc_ndims >= 2){ - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation\n") ; - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation\n") ; - if (max_alloc_ndims >= 3){ - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation\n") ; - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation\n") ; - if (max_alloc_ndims >= 4){ - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: b4 ! temporary for extrapolation/interpolation\n") ; - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: c4 ! temporary for extrapolation/interpolation\n") ; - if (max_alloc_ndims >= 5){ - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: b5 ! temporary for extrapolation/interpolation\n") ; - fprintf(fp," REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: c5 ! temporary for extrapolation/interpolation\n") ; - } // 5 - } // 4 - } // 3 - } // 2 - } // 1 - } // 0 - fprintf(fp," INTEGER(IntKi) :: ErrStat2 ! local errors\n"); - fprintf(fp," CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"); - for ( j = 1 ; j <= max_ndims ; j++ ) { - for ( i = 0 ; i <= max_nrecurs ; i++ ) { - fprintf(fp," INTEGER :: i%d%d ! dim%d level %d counter variable for arrays of ddts\n",i,j,j,i) ; - } - } - fprintf(fp," ! Initialize ErrStat\n") ; - fprintf(fp," ErrStat = ErrID_None\n") ; - fprintf(fp," ErrMsg = \"\"\n") ; - fprintf(fp," ! we'll subtract a constant from the times to resolve some \n") ; - fprintf(fp," ! numerical issues when t gets large (and to simplify the equations)\n") ; - fprintf(fp," t = tin - tin(1)\n") ; - fprintf(fp," t_out = tin_out - tin(1)\n") ; - fprintf(fp,"\n") ; - fprintf(fp, " if ( size(t) .ne. size(%s)) then\n", uy); - fprintf(fp," ErrStat = ErrID_Fatal\n") ; - fprintf(fp, " ErrMsg = ' Error in %s_%s_ExtrapInterp: size(t) must equal size(%s) '\n", ModName->nickname, typnm, uy); - fprintf(fp," RETURN\n") ; - fprintf(fp," endif\n") ; - fprintf(fp, " if (size(%s) .gt. 3) then\n", uy); - fprintf(fp," ErrStat = ErrID_Fatal\n") ; - fprintf(fp, " ErrMsg = ' Error in %s_%s_ExtrapInterp: size(%s) must be less than 4 '\n", ModName->nickname, typnm, uy); - fprintf(fp," RETURN\n") ; - fprintf(fp," endif\n") ; - - fprintf(fp, " order = SIZE(%s) - 1\n", uy); - - fprintf(fp," IF ( order .eq. 0 ) THEN\n") ; - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - if ( q->usefrom == 0 ) { - ddtname = q->name ; - remove_nickname(ModName->nickname,ddtname,nonick) ; - if ( !strcmp( nonick, make_lower_temp(typnmlong) )) { - for ( r = q->fields ; r ; r = r->next ) - { - // recursive - gen_extint_order( fp, ModName, typnm, uy, 0, r, "", 0 ) ; - } - } - } - } - - fprintf(fp," ELSE IF ( order .eq. 1 ) THEN\n") ; -fprintf(fp," IF ( EqualRealNos( t(1), t(2) ) ) THEN\n") ; -fprintf(fp," ErrStat = ErrID_Fatal\n") ; -fprintf(fp," ErrMsg = ' Error in %s_%s_ExtrapInterp: t(1) must not equal t(2) to avoid a division-by-zero error.'\n",ModName->nickname,typnm) ; -fprintf(fp," RETURN\n") ; -fprintf(fp," END IF\n") ; - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - - if ( q->usefrom == 0 ) { - ddtname = q->name ; - remove_nickname(ModName->nickname,ddtname,nonick) ; - if ( !strcmp( nonick, make_lower_temp(typnmlong) )) { - for ( r = q->fields ; r ; r = r->next ) - { - // recursive - gen_extint_order( fp, ModName, typnm, uy, 1, r, "", 0 ) ; - } - } - } - } - fprintf(fp," ELSE IF ( order .eq. 2 ) THEN\n") ; -fprintf(fp," IF ( EqualRealNos( t(1), t(2) ) ) THEN\n") ; -fprintf(fp," ErrStat = ErrID_Fatal\n") ; -fprintf(fp," ErrMsg = ' Error in %s_%s_ExtrapInterp: t(1) must not equal t(2) to avoid a division-by-zero error.'\n",ModName->nickname,typnm) ; -fprintf(fp," RETURN\n") ; -fprintf(fp," END IF\n") ; -fprintf(fp," IF ( EqualRealNos( t(2), t(3) ) ) THEN\n") ; -fprintf(fp," ErrStat = ErrID_Fatal\n") ; -fprintf(fp," ErrMsg = ' Error in %s_%s_ExtrapInterp: t(2) must not equal t(3) to avoid a division-by-zero error.'\n",ModName->nickname,typnm) ; -fprintf(fp," RETURN\n") ; -fprintf(fp," END IF\n") ; -fprintf(fp," IF ( EqualRealNos( t(1), t(3) ) ) THEN\n") ; -fprintf(fp," ErrStat = ErrID_Fatal\n") ; -fprintf(fp," ErrMsg = ' Error in %s_%s_ExtrapInterp: t(1) must not equal t(3) to avoid a division-by-zero error.'\n",ModName->nickname,typnm) ; -fprintf(fp," RETURN\n") ; -fprintf(fp," END IF\n") ; - - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - if ( q->usefrom == 0 ) { - ddtname = q->name ; - remove_nickname(ModName->nickname,ddtname,nonick) ; - if ( !strcmp( nonick, make_lower_temp(typnmlong) )) { - for ( r = q->fields ; r ; r = r->next ) - { - // recursive - gen_extint_order( fp, ModName, typnm, uy, 2, r, "", 0 ) ; - } - } - } - } - fprintf(fp," ELSE \n") ; - fprintf(fp," ErrStat = ErrID_Fatal\n") ; - fprintf(fp," ErrMsg = ' order must be less than 3 in %s_%s_ExtrapInterp '\n",ModName->nickname,typnm) ; - fprintf(fp," RETURN\n") ; - fprintf(fp," ENDIF \n") ; - - - fprintf(fp," END SUBROUTINE %s_%s_ExtrapInterp\n",ModName->nickname,typnm) ; - fprintf(fp,"\n") ; -} -#endif - -void -gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlong, char * xtypnm, char * uy, char * modPrefix, const int max_ndims, const int max_nrecurs, const int max_alloc_ndims, const node_t *q) -{ - node_t *r; - int i, j; - - fprintf(fp, "\n"); - fprintf(fp, " SUBROUTINE %s_%s_ExtrapInterp1(%s1, %s2, tin, %s_out, tin_out, ErrStat, ErrMsg )\n", ModName->nickname, typnm, uy, uy, uy); - fprintf(fp, "!\n"); - fprintf(fp, "! This subroutine calculates a extrapolated (or interpolated) %s %s_out at time t_out, from previous/future time\n", typnm, uy); - fprintf(fp, "! values of %s (which has values associated with times in t). Order of the interpolation is 1.\n", uy); - fprintf(fp, "!\n"); - fprintf(fp, "! f(t) = a + b * t, or\n"); - fprintf(fp, "!\n"); - fprintf(fp, "! where a and b are determined as the solution to\n"); - fprintf(fp, "! f(t1) = %s1, f(t2) = %s2\n", uy, uy); - fprintf(fp, "!\n"); - fprintf(fp, "!..................................................................................................................................\n"); - fprintf(fp, "\n"); - - - fprintf(fp, " TYPE(%s%s), INTENT(%s) :: %s1 ! %s at t1 > t2\n", modPrefix, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); - fprintf(fp, " TYPE(%s%s), INTENT(%s) :: %s2 ! %s at t2 \n", modPrefix, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); - fprintf(fp, " REAL(%s), INTENT(IN ) :: tin(2) ! Times associated with the %ss\n", xtypnm, typnm); - fprintf(fp, " TYPE(%s%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", modPrefix, typnmlong, uy, typnm); - fprintf(fp, " REAL(%s), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to\n", xtypnm); - fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n"); - fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n"); - fprintf(fp, " ! local variables\n"); - fprintf(fp, " REAL(%s) :: t(2) ! Times associated with the %ss\n", xtypnm, typnm); - fprintf(fp, " REAL(%s) :: t_out ! Time to which to be extrap/interpd\n", xtypnm); - fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_%s_ExtrapInterp1'\n", ModName->nickname, typnm); - - - fprintf(fp, " REAL(DbKi) :: b ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " INTEGER(IntKi) :: ErrStat2 ! local errors\n"); - fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"); - for (j = 1; j <= max_ndims; j++) { - for (i = 0; i <= max_nrecurs; i++) { - fprintf(fp, " INTEGER :: i%d%d ! dim%d level %d counter variable for arrays of ddts\n", i, j, j, i); - } - } - for (j = 1; j <= max_ndims; j++) { - fprintf(fp, " INTEGER :: i%d ! dim%d counter variable for arrays\n", j, j); - } - - fprintf(fp, " ! Initialize ErrStat\n"); - fprintf(fp, " ErrStat = ErrID_None\n"); - fprintf(fp, " ErrMsg = \"\"\n"); - fprintf(fp, " ! we'll subtract a constant from the times to resolve some \n"); - fprintf(fp, " ! numerical issues when t gets large (and to simplify the equations)\n"); - fprintf(fp, " t = tin - tin(1)\n"); - fprintf(fp, " t_out = tin_out - tin(1)\n"); - fprintf(fp, "\n"); - - fprintf(fp, " IF ( EqualRealNos( t(1), t(2) ) ) THEN\n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n\n"); - - fprintf(fp, " ScaleFactor = t_out / t(2)\n"); - - for (r = q->fields; r; r = r->next) - { - // recursive - gen_extint_order(fp, ModName, typnm, uy, 1, r, "", 0); - } - - - fprintf(fp, " END SUBROUTINE %s_%s_ExtrapInterp1\n", ModName->nickname, typnm); - fprintf(fp, "\n"); -} - -void -gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlong, char * xtypnm, char * uy, char * modPrefix, const int max_ndims, const int max_nrecurs, const int max_alloc_ndims, const node_t *q) -{ - node_t *r; - int i, j; - - fprintf(fp, "\n"); - fprintf(fp, " SUBROUTINE %s_%s_ExtrapInterp2(%s1, %s2, %s3, tin, %s_out, tin_out, ErrStat, ErrMsg )\n", ModName->nickname, typnm, uy, uy, uy, uy); - fprintf(fp, "!\n"); - fprintf(fp, "! This subroutine calculates a extrapolated (or interpolated) %s %s_out at time t_out, from previous/future time\n", typnm, uy); - fprintf(fp, "! values of %s (which has values associated with times in t). Order of the interpolation is 2.\n", uy); - fprintf(fp, "!\n"); - fprintf(fp, "! expressions below based on either\n"); - fprintf(fp, "!\n"); - fprintf(fp, "! f(t) = a + b * t + c * t**2\n"); - fprintf(fp, "!\n"); - fprintf(fp, "! where a, b and c are determined as the solution to\n"); - fprintf(fp, "! f(t1) = %s1, f(t2) = %s2, f(t3) = %s3\n", uy, uy, uy); - fprintf(fp, "!\n"); - fprintf(fp, "!..................................................................................................................................\n"); - fprintf(fp, "\n"); - - fprintf(fp, " TYPE(%s%s), INTENT(%s) :: %s1 ! %s at t1 > t2 > t3\n", modPrefix, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); - fprintf(fp, " TYPE(%s%s), INTENT(%s) :: %s2 ! %s at t2 > t3\n", modPrefix, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); - fprintf(fp, " TYPE(%s%s), INTENT(%s) :: %s3 ! %s at t3\n", modPrefix, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); - fprintf(fp, " REAL(%s), INTENT(IN ) :: tin(3) ! Times associated with the %ss\n", xtypnm, typnm); - fprintf(fp, " TYPE(%s%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", modPrefix, typnmlong, uy, typnm); - fprintf(fp, " REAL(%s), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to\n", xtypnm); - - fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n" ); - fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n"); - fprintf(fp, " ! local variables\n"); - fprintf(fp, " REAL(%s) :: t(3) ! Times associated with the %ss\n", xtypnm, typnm); - fprintf(fp, " REAL(%s) :: t_out ! Time to which to be extrap/interpd\n", xtypnm); - fprintf(fp, " INTEGER(IntKi) :: order ! order of polynomial fit (max 2)\n"); - - fprintf(fp, " REAL(DbKi) :: b ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi) :: c ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " INTEGER(IntKi) :: ErrStat2 ! local errors\n"); - fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"); - fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_%s_ExtrapInterp2'\n", ModName->nickname, typnm); - for (j = 1; j <= max_ndims; j++) { - for (i = 0; i <= max_nrecurs; i++) { - fprintf(fp, " INTEGER :: i%d%d ! dim%d level %d counter variable for arrays of ddts\n", i, j, j, i); - } - } - for (j = 1; j <= max_ndims; j++) { - fprintf(fp, " INTEGER :: i%d ! dim%d counter variable for arrays\n", j, j); - } - fprintf(fp, " ! Initialize ErrStat\n"); - fprintf(fp, " ErrStat = ErrID_None\n"); - fprintf(fp, " ErrMsg = \"\"\n"); - fprintf(fp, " ! we'll subtract a constant from the times to resolve some \n"); - fprintf(fp, " ! numerical issues when t gets large (and to simplify the equations)\n"); - fprintf(fp, " t = tin - tin(1)\n"); - fprintf(fp, " t_out = tin_out - tin(1)\n"); - fprintf(fp, "\n"); - - - fprintf(fp, " IF ( EqualRealNos( t(1), t(2) ) ) THEN\n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN\n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN\n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n\n"); - - fprintf(fp, " ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3)))\n"); - - - - for (r = q->fields; r; r = r->next) - { - // recursive - gen_extint_order(fp, ModName, typnm, uy, 2, r, "", 0); - } - - - fprintf(fp, " END SUBROUTINE %s_%s_ExtrapInterp2\n", ModName->nickname, typnm); - fprintf(fp, "\n"); -} - - -void -gen_ExtrapInterp(FILE *fp, const node_t * ModName, char * typnm, char * typnmlong, char * xtypnm, const int useModPrefix) -{ - char nonick[NAMELEN]; - char *ddtname; char uy[2]; char modPrefix[NAMELEN + 1]; - node_t *q, *r; - int max_ndims, max_nrecurs, max_alloc_ndims; - - if (!strcmp(make_lower_temp(typnm), "output")){ - strcpy(uy, "y"); - } - else{ - strcpy(uy, "u"); - } - - if (useModPrefix == 1) { - strcpy(modPrefix, ModName->nickname); - strcat(modPrefix, "_"); - } - else - { - strcpy(modPrefix, ""); - } - - for (q = ModName->module_ddt_list; q; q = q->next) - { - if (q->usefrom == 0) { - ddtname = q->name; - remove_nickname(ModName->nickname, ddtname, nonick); - if (!strcmp(nonick, make_lower_temp(typnmlong))) { - - fprintf(fp, "\n"); - fprintf(fp, " SUBROUTINE %s_%s_ExtrapInterp(%s, t, %s_out, t_out, ErrStat, ErrMsg )\n", ModName->nickname, typnm, uy, uy); - fprintf(fp, "!\n"); - fprintf(fp, "! This subroutine calculates a extrapolated (or interpolated) %s %s_out at time t_out, from previous/future time\n", typnm, uy); - fprintf(fp, "! values of %s (which has values associated with times in t). Order of the interpolation is given by the size of %s\n", uy, uy); - fprintf(fp, "!\n"); - fprintf(fp, "! expressions below based on either\n"); - fprintf(fp, "!\n"); - fprintf(fp, "! f(t) = a\n"); - fprintf(fp, "! f(t) = a + b * t, or\n"); - fprintf(fp, "! f(t) = a + b * t + c * t**2\n"); - fprintf(fp, "!\n"); - fprintf(fp, "! where a, b and c are determined as the solution to\n"); - fprintf(fp, "! f(t1) = %s1, f(t2) = %s2, f(t3) = %s3 (as appropriate)\n", uy, uy, uy); - fprintf(fp, "!\n"); - fprintf(fp, "!..................................................................................................................................\n"); - fprintf(fp, "\n"); - - - fprintf(fp, " TYPE(%s%s), INTENT(%s) :: %s(:) ! %s at t1 > t2 > t3\n", modPrefix, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); - fprintf(fp, " REAL(%s), INTENT(IN ) :: t(:) ! Times associated with the %ss\n", xtypnm, typnm); - //jm Modified from INTENT( OUT) to INTENT(INOUT) to prevent ALLOCATABLE array arguments in the DDT - //jm from being maliciously deallocated through the call.See Sec. 5.1.2.7 of bonehead Fortran 2003 standard - fprintf(fp, " TYPE(%s%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", modPrefix, typnmlong, uy, typnm); - fprintf(fp, " REAL(%s), INTENT(IN ) :: t_out ! time to be extrap/interp'd to\n", xtypnm); - fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n"); - fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n"); - fprintf(fp, " ! local variables\n"); - fprintf(fp, " INTEGER(IntKi) :: order ! order of polynomial fit (max 2)\n"); - fprintf(fp, " INTEGER(IntKi) :: ErrStat2 ! local errors\n"); - fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"); - fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_%s_ExtrapInterp'\n", ModName->nickname, typnm); - fprintf(fp, " ! Initialize ErrStat\n"); - fprintf(fp, " ErrStat = ErrID_None\n"); - fprintf(fp, " ErrMsg = \"\"\n"); - fprintf(fp, " if ( size(t) .ne. size(%s)) then\n", uy); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(%s)',ErrStat,ErrMsg,RoutineName)\n",uy); - fprintf(fp, " RETURN\n"); - fprintf(fp, " endif\n"); - - fprintf(fp, " order = SIZE(%s) - 1\n", uy); - - fprintf(fp, " IF ( order .eq. 0 ) THEN\n"); - fprintf(fp, " CALL %s_Copy%s(%s(1), %s_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", ModName->nickname, typnm, uy, uy); - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " ELSE IF ( order .eq. 1 ) THEN\n"); - fprintf(fp, " CALL %s_%s_ExtrapInterp1(%s(1), %s(2), t, %s_out, t_out, ErrStat2, ErrMsg2 )\n", ModName->nickname, typnm, uy, uy, uy); - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " ELSE IF ( order .eq. 2 ) THEN\n"); - fprintf(fp, " CALL %s_%s_ExtrapInterp2(%s(1), %s(2), %s(3), t, %s_out, t_out, ErrStat2, ErrMsg2 )\n", ModName->nickname, typnm, uy, uy, uy, uy); - fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); - fprintf(fp, " ELSE \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal,'size(%s) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName)\n", uy); - fprintf(fp, " RETURN\n"); - fprintf(fp, " ENDIF \n"); - - fprintf(fp, " END SUBROUTINE %s_%s_ExtrapInterp\n", ModName->nickname, typnm); - fprintf(fp, "\n"); - - - max_ndims = 0; // ModName->module_ddt_list->max_ndims; //bjj: this is max for module, not for typnmlong - max_nrecurs = 0; // MAXRECURSE; - max_alloc_ndims = 0; - - for (r = q->fields; r; r = r->next) - { - // recursive - calc_extint_order(fp, ModName, r, 0, &max_ndims, &max_nrecurs, &max_alloc_ndims); - } - - gen_ExtrapInterp1(fp, ModName, typnm, typnmlong, xtypnm, uy, modPrefix, max_ndims, max_nrecurs, max_alloc_ndims, q); - gen_ExtrapInterp2(fp, ModName, typnm, typnmlong, xtypnm, uy, modPrefix, max_ndims, max_nrecurs, max_alloc_ndims, q); - - } - } - } - - - -} - - - - - - - -void -gen_rk4( FILE *fp , const node_t * ModName ) -{ - char nonick[NAMELEN] ; - char *ddtname ; - node_t *q, * r ; - int founddt, k ; - -// make sure the user has dt in their parameter types - founddt = 0 ; - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - if ( q->usefrom == 0 ) { - ddtname = q->name ; - remove_nickname(ModName->nickname,ddtname,nonick) ; - if ( !strcmp( nonick, "parametertype")) { - for ( r = q->fields ; r ; r = r->next ) - { - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") || - !strcmp( r->type->mapsto, "REAL(SiKi)") || - !strcmp( r->type->mapsto, "REAL(R8Ki)") || - !strcmp( r->type->mapsto, "REAL(DbKi)")) - { - if ( !strcmp(make_lower_temp(r->name),"dt") ) { - founddt = 1 ; - } - } - } - } - } - } - if ( !founddt ) { - fprintf(stderr,"Registry warning: cannot generate %s_RK4. Add dt to ParameterType for this module\n", ModName->nickname) ; - return ; - } - - - fprintf(fp," SUBROUTINE %s_RK4(t, u, u_next, p, x, xd, z, OtherState, m, xdot, ErrStat, ErrMsg )\n", - ModName->nickname) ; - fprintf(fp," REAL(DbKi), INTENT(IN ) :: t ! Current simulation time in seconds\n") ; - fprintf(fp," TYPE(%s_InputType), INTENT(IN ) :: u ! Inputs at t\n", ModName->nickname) ; - fprintf(fp," TYPE(%s_InputType), INTENT(IN ) :: u_next ! Inputs at t\n", ModName->nickname) ; - fprintf(fp," TYPE(%s_ParameterType), INTENT(IN ) :: p ! Parameters\n", ModName->nickname) ; - fprintf(fp," TYPE(%s_ContinuousStateType), INTENT(INOUT) :: x ! Continuous states at t on input at t + dt on output\n", - ModName->nickname) ; - fprintf(fp," TYPE(%s_DiscreteStateType), INTENT(INOUT) :: xd ! Discrete states at t\n", ModName->nickname) ; - fprintf(fp," TYPE(%s_ConstraintStateType), INTENT(IN ) :: z ! Constraint states at t (possibly a guess)\n", - ModName->nickname) ; - fprintf(fp," TYPE(%s_OtherStateType), INTENT(INOUT) :: OtherState ! Other states\n", ModName->nickname) ; - fprintf(fp, " TYPE(%s_MiscVarType), INTENT(INOUT) :: m ! Misc/optimization variables\n", ModName->nickname); - fprintf(fp, " TYPE(%s_ContinuousStateType), INTENT(IN ) :: xdot ! Continuous states at t on input at t + dt on output\n", - ModName->nickname) ; - fprintf(fp," INTEGER(IntKi), INTENT( OUT) :: ErrStat\n") ; - fprintf(fp," CHARACTER(*), INTENT( OUT) :: ErrMsg\n") ; - fprintf(fp," ! Local variables\n" ) ; - fprintf(fp," TYPE(%s_ContinuousStateType) :: xdot_local ! t derivatives of continuous states\n", - ModName->nickname) ; - fprintf(fp," TYPE(%s_ContinuousStateType) :: k1\n", - ModName->nickname) ; - fprintf(fp," TYPE(%s_ContinuousStateType) :: k2\n", - ModName->nickname) ; - fprintf(fp," TYPE(%s_ContinuousStateType) :: k3\n", - ModName->nickname) ; - fprintf(fp," TYPE(%s_ContinuousStateType) :: k4\n", - ModName->nickname) ; - fprintf(fp," TYPE(%s_ContinuousStateType) :: x_tmp ! Holds temporary modification to x\n", - ModName->nickname) ; - fprintf(fp," TYPE(%s_InputType) :: u_interp\n", - ModName->nickname) ; - fprintf(fp," REAL(ReKi) :: alpha\n") ; - - fprintf(fp," ! Initialize ErrStat\n") ; - - fprintf(fp," ErrStat = ErrID_None\n") ; - fprintf(fp," ErrMsg = \"\"\n") ; - fprintf(fp," !CALL %s_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, xdot_local, ErrStat, ErrMsg )\n", - ModName->nickname) ; - fprintf(fp," alpha = 0.5\n") ; - for ( k = 1 ; k <= 4 ; k++ ) - { -// generate statements for k1 - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - if ( q->usefrom == 0 ) { - ddtname = q->name ; - remove_nickname(ModName->nickname,ddtname,nonick) ; - if ( !strcmp( nonick, "continuousstatetype")) { - for ( r = q->fields ; r ; r = r->next ) - { - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)") || - !strcmp(r->type->mapsto, "REAL(DbKi)")) - { - fprintf(fp," k%d%%%s = p%%dt * xdot%s%%%s\n",k,r->name,(k<2)?"":"_local",r->name) ; - } - } - } - } - } -// generate statements for x_tmp - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - if ( q->usefrom == 0 ) { - ddtname = q->name ; - remove_nickname(ModName->nickname,ddtname,nonick) ; - if ( !strcmp( nonick, "continuousstatetype")) { - for ( r = q->fields ; r ; r = r->next ) - { - if ( !strcmp( r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)") || - !strcmp(r->type->mapsto, "REAL(DbKi)")) - { - if ( k < 4 ) { - fprintf(fp," x_tmp%%%s = x%%%s + %s k%d%%%s\n",r->name,r->name,(k<3)?"0.5*":"",k,r->name) ; - } else { - fprintf(fp," x%%%s = x%%%s + ( k1%%%s + 2. * k2%%%s + 2. * k3%%%s + k4%%%s ) / 6.\n",r->name,r->name,r->name,r->name,r->name,r->name) ; - } - } - } - } - } - } - - if (k == 1) fprintf(fp," CALL %s_LinearInterpInput(u, u_next, u_interp, alpha, ErrStat, ErrMsg)\n", - ModName->nickname) ; - if (k < 4 )fprintf(fp," CALL %s_CalcContStateDeriv( t+%sp%%dt, u_%s, p, x_tmp, xd, z, OtherState, m, xdot_local, ErrStat, ErrMsg )\n", - ModName->nickname, - (k<3)?"0.5*":"", - (k<3)?"interp":"next") ; - fprintf(fp,"\n") ; - } - fprintf(fp," END SUBROUTINE %s_RK4\n",ModName->nickname) ; - - -} - - -void -gen_module( FILE * fp , node_t * ModName, char * prog_ver ) -{ - node_t * p, * q, * r ; - int i ; - int ipass ; - char nonick[NAMELEN] ; - char tmp[NAMELEN] ; - char ** p1; - - if ( strlen(ModName->nickname) > 0 ) { -// gen preamble - { - fprintf( fp, "! %s\n", prog_ver ); - - for ( p1 = FAST_preamble ; *p1 ; p1++ ) { fprintf( fp, *p1, ModName->name ) ; } - } - for ( p = ModNames ; p ; p = p->next ) - { - // Add use declarations for Modules that are included as "usefrom" - if ( p->usefrom == 1 ) { - if ( strcmp(make_lower_temp(p->name),"nwtc_library") ) { - fprintf(fp,"USE %s_Types\n",p->name) ; - } - } - } - if ( sw_ccode ) { -// Generate a container object for the Fortran code to carry around a pointer to the CPP object(s) - //fprintf(fp,"USE %s_C_Types\n",ModName->nickname) ; - fprintf(fp,"!USE, INTRINSIC :: ISO_C_Binding\n") ; // this is inherited from NWTC_Library.f90, and older versions of gfortran complain about ambiguous data when we use this (it thinks it's declared twice; see http://gcc.gnu.org/ml/fortran/2013-04/msg00166.html ) - } - -// if this is the NWTC Library, we're not going to print "USE NWTC_Library" - if ( strcmp(make_lower_temp(ModName->name),"nwtc_library") == 0 ) { - fprintf(fp,"USE SysSubs\n"); - } else { - fprintf(fp,"USE NWTC_Library\n"); - } - - fprintf(fp,"IMPLICIT NONE\n") ; - -#if 0 - if ( sw_ccode ) { - fprintf(fp," TYPE MAP_In_C \n") ; - fprintf(fp," ! This allows us to create an instance of a C++ \n") ; - fprintf(fp," ! object in Fortran. From the perspective of \n") ; - fprintf(fp," ! Fortran, this is seen as an address in memory\n") ; - fprintf(fp," PRIVATE\n") ; - fprintf(fp," TYPE(C_ptr) :: %s_UserData = C_NULL_ptr\n",ModName->nickname) ; - fprintf(fp," END TYPE MAP_In_C \n") ; - } -#endif - -// generate parameters - for ( q = ModName->params ; q ; q = q->next ) - { - fprintf(fp," %s, PUBLIC, PARAMETER ",q->type->mapsto ) ; - if ( q->ndims > 0 ) - { - if ( q->dims[0]->deferred ) - { - fprintf(stderr,"Registry warning: parameter %s can not have deferred type\n",q->name) ; - fprintf(fp,"), ALLOCATABLE ") ; - } else { - fprintf(fp,", DIMENSION(") ; - for ( i = 0 ; i < q->ndims ; i++ ) - { - fprintf(fp,"%d:%d",q->dims[i]->coord_start,q->dims[i]->coord_end) ; - if ( i < q->ndims-1 ) fprintf(fp,",") ; - } - fprintf(fp,") ") ; - } - } - if ( strlen(q->inival) > 0 ) { - if ( q->ndims > 0 ) { - fprintf(fp," :: %s = (/%s/)", q->name, q->inival ) ; - } else { - fprintf(fp," :: %s = %s ", q->name, q->inival ) ; - } - } else { - fprintf(fp," :: %s",q->name) ; - } - if ( strcmp( q->descrip, "-" ) || strcmp( q->units, "-" ) ) /* that is, if not equal "-" */ { - fprintf(fp," ! %s [%s]", q->descrip, q->units) ; - } - fprintf(fp,"\n") ; - } - -// generate each derived data type - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - if (*q->mapsto) remove_nickname( ModName->nickname, make_lower_temp(q->mapsto) , nonick ) ; - fprintf(fp, "! ========= %s%s =======\n", q->mapsto, (sw_ccode) ? "_C" : ""); - for ( ipass = (sw_ccode)?0:1 ; ipass < 2 ; ipass++ ) { // 2 passes for C code, 1st pass generates bound ddt - if ( q->usefrom == 0 ) { - fprintf(fp," TYPE, %s :: %s%s\n",(ipass==0)?"BIND(C)":"PUBLIC",q->mapsto,(ipass==0)?"_C":"") ; - if ( sw_ccode ) { - if ( ipass == 0 ) { -// q->containsPtr = 1; - //if (!strcmp(make_lower_temp(nonick), "otherstatetype") || !strcmp(make_lower_temp(nonick), "initinputtype")){ - fprintf(fp, " TYPE(C_PTR) :: object = C_NULL_PTR\n"); - //} - } else { - fprintf(fp," TYPE( %s_C ) :: C_obj\n",q->mapsto) ; - } - } - for ( r = q->fields ; r ; r = r->next ) - { - if ( r->type != NULL ) { - // check max number of dimmensions - // check if this type contains any pointers/meshes or types that have pointers/meshes - if (r->ndims > q->max_ndims) q->max_ndims = r->ndims; - if (r->ndims > ModName->module_ddt_list->max_ndims) ModName->module_ddt_list->max_ndims = r->ndims; - if ( ipass == 0 ) { - //r->containsPtr = 1; - //q->containsPtr = 1; - if ( r->ndims == 0 && r->type->type_type != DERIVED ) { - fprintf(fp," %s :: %s \n",c_types_binding( r->type->mapsto), r->name) ; - } else if ( r->ndims > 0 && r->type->type_type != DERIVED ) { - if (r->dims[0]->deferred ) { - fprintf(fp," TYPE(C_ptr) :: %s = C_NULL_PTR \n", r->name) ; - fprintf(fp," INTEGER(C_int) :: %s_Len = 0 \n", r->name) ; - } - else { - if (strcmp(C_type(r->type->mapsto), "char")){ - fprintf(fp," TYPE(C_PTR) :: %s(", r->name) ; - for ( i = 0 ; i < r->ndims ; i++ ) - { - fprintf(fp,"%d",r->dims[i]->coord_end) ; - if ( i < r->ndims-1 ) fprintf(fp,",") ; - } - fprintf(fp,")\n") ; - } - - } - } - } else { // ipass /= 0 - if ( r->type->type_type == DERIVED ) { - fprintf(fp," TYPE(%s) ",r->type->mapsto ) ; - - checkContainsMesh(r); - if (r->containsPtr) q->containsPtr = 1; - - // bjj: we need to make sure these types map to reals, too - tmp[0] = '\0' ; - if (*q->mapsto ) remove_nickname( ModName->nickname, make_lower_temp(q->mapsto) , tmp ) ; - if ( must_have_real_or_double(tmp) ) checkOnlyReals( q->mapsto, r ); - - - } else { - tmp[0] = '\0' ; - if (*q->mapsto ) remove_nickname( ModName->nickname, make_lower_temp(q->mapsto) , tmp ) ; - if ( must_have_real_or_double(tmp) ) { - if ( strncmp(r->type->mapsto,"REAL",4) ) { - fprintf(stderr,"Registry warning: %s contains a field (%s) whose type is not real or double: %s\n", - q->mapsto, r->name , r->type->mapsto ) ; - } - - } - if (sw_ccode && is_pointer(r) ) { - fprintf(fp," %s ",c_types_binding(r->type->mapsto) ) ; - } else { - fprintf(fp," %s ",r->type->mapsto ) ; - } - } - - if ( r->ndims > 0 ) - { - if ( r->dims[0]->deferred ) // if one dim is deferred they all have to be; see check in type.c - { - fprintf(fp,", DIMENSION(") ; - for ( i = 0 ; i < r->ndims ; i++ ) - { - fprintf(fp,":") ; - if ( i < r->ndims-1 ) fprintf(fp,",") ; - } - if ( is_pointer(r) ) { - fprintf(fp,"), POINTER ") ; - } else { - fprintf(fp,"), ALLOCATABLE ") ; - } - - } else { - fprintf(fp,", DIMENSION(") ; - for ( i = 0 ; i < r->ndims ; i++ ) - { - if (r->dims[i]->dim_param == 0){ - fprintf(fp, "%d:%d", r->dims[i]->coord_start, r->dims[i]->coord_end) ; - } - else { - //fprintf(stderr, "start, %s, %s, %s\n", dimspec, dim_entry->name, dim_entry->module); - // if (r->module != NULL) { node_t *param_dim = get_entry(r->dims[i]->dim_param_name, r->module->params); } - - fprintf(fp, "%s", r->dims[i]->dim_param_name); - } - if ( i < r->ndims-1 ) fprintf(fp,",") ; - } - fprintf(fp,") ") ; - } - } - - - if ( is_pointer( r ) ) { - fprintf(fp," :: %s => NULL() ",r->name) ; - } else if ( r->ndims == 0 && strlen(r->inival) > 0 ) { - fprintf(fp," :: %s = %s ", r->name, r->inival ) ; - } else { - fprintf(fp," :: %s ",r->name) ; - } - - if ( strcmp( r->descrip, "-" ) || strcmp( r->units, "-" ) ) /* that is, if not equal "-" */ { - fprintf(fp," !< %s [%s]", r->descrip, r->units) ; - } - fprintf(fp,"\n") ; - } // ipass /= 0 - } - } - fprintf(fp," END TYPE %s%s\n",q->mapsto,(ipass==0)?"_C":"") ; - //fprintf(stderr, "module %d type %d\n", ModName->module_ddt_list->max_ndims, q->max_ndims); - - } - } - fprintf(fp,"! =======================\n") ; - } - - if ( sw_ccode ) { - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - - if ( q->usefrom == 0 ) { - - char * ddtname, * ddtnamelong, nonick[NAMELEN] ; - ddtname = q->name ; - - remove_nickname(ModName->nickname,ddtname,nonick) ; - - if ( is_a_fast_interface_type( nonick ) ) { - ddtnamelong = nonick ; - ddtname = fast_interface_type_shortname( nonick ) ; - } else { - ddtnamelong = ddtname ; - } - - } - } - } // sw_ccode - - - fprintf(fp,"CONTAINS\n") ; - for ( q = ModName->module_ddt_list ; q ; q = q->next ) - { - if ( q->usefrom == 0 ) { - - char * ddtname, * ddtnamelong, nonick[NAMELEN] ; - //ddtname = q->name ; - ddtname = q->mapsto; - - remove_nickname(ModName->nickname,ddtname,nonick) ; - -//fprintf(stderr,">> %s %s %s \n",ModName->name, ddtname, nonick) ; - - if ( is_a_fast_interface_type( nonick ) ) { - ddtnamelong = nonick ; - ddtname = fast_interface_type_shortname( nonick ) ; - } else { - ddtnamelong = ddtname ; - } - - gen_copy( fp, ModName, ddtname, ddtnamelong , q) ; - gen_destroy( fp, ModName, ddtname, ddtnamelong ) ; - gen_pack( fp, ModName, ddtname, ddtnamelong ) ; - gen_unpack( fp, ModName, ddtname, ddtnamelong ) ; - if ( sw_ccode ) { - gen_copy_c2f( fp, ModName, ddtname, ddtnamelong ) ; - gen_copy_f2c(fp, ModName, ddtname, ddtnamelong); - } - - } - } -// bjj: removed gen_modname_pack and gen_modname_unpack because i don't see them being used any differently than the other pack/unpack routines 02/22/2014 -// gen_modname_pack( fp, ModName ) ; -// gen_modname_unpack( fp, ModName ) ; -// gen_rk4( fp, ModName ) ; - - if (strcmp(make_lower_temp(ModName->name), "airfoilinfo") == 0) { // make interpolation routines for AirfoilInfo module - gen_ExtrapInterp(fp, ModName, "Output", "OutputType","ReKi",1); - gen_ExtrapInterp(fp, ModName, "UA_BL_Type", "UA_BL_Type", "ReKi",1); - } else if (!sw_noextrap) { - if (strcmp(make_lower_temp(ModName->name), "dbemt") == 0) { // make interpolation routines for element-level DBEMT module - gen_ExtrapInterp(fp, ModName, "ElementInputType", "ElementInputType", "DbKi",1); - } -// else if (strcmp(make_lower_temp(ModName->name), "bemt") == 0) { -// gen_ExtrapInterp(fp, ModName, "SkewWake_InputType", "SkewWake_InputType", "DbKi",1); -// } -// else if (strcmp(make_lower_temp(ModName->name), "aerodyn") == 0) { -// gen_ExtrapInterp(fp, ModName, "RotInputType", "RotInputType", "DbKi",0); // don't append "AD_" to the type name! -// } - - gen_ExtrapInterp(fp, ModName, "Input", "InputType", "DbKi",1); - gen_ExtrapInterp(fp, ModName, "Output", "OutputType", "DbKi",1); - } - - fprintf(fp,"END MODULE %s_Types\n",ModName->name ) ; - } - -} - - -int -gen_module_files ( char * dirname, char * prog_ver ) -{ - FILE * fp, *fph ; - char fname[NAMELEN], fname2[NAMELEN] ; - - node_t * p ; - - for ( p = ModNames ; p ; p = p->next ) - { - if ( strlen( p->nickname ) > 0 && ! p->usefrom ) { - fp = NULL ; - - if ( strlen(dirname) > 0 ) - { sprintf(fname,"%s/%s_Types.f90",dirname,p->name) ; } - else - { sprintf(fname,"%s_Types.f90",p->name) ; } - sprintf(fname2, "%s_Types.f90", p->name); - - fprintf(stderr,"generating %s\n",fname) ; - - if ((fp = fopen( fname , "w" )) == NULL ) return(1) ; - print_warning(fp,fname2, ""); - - gen_module ( fp , p, prog_ver ) ; - close_the_file( fp, "" ) ; - - // generate .h files for C/C++: - if ( sw_ccode ) { - if (strlen(dirname) > 0) - { - sprintf(fname, "%s/%s_Types.h", dirname, p->name); - } - else - { - sprintf(fname, "%s_Types.h", p->name); - } - sprintf(fname2, "%s_Types.h", p->name); - fprintf(stderr, "generating %s\n", fname); - - if ((fph = fopen(fname, "w")) == NULL) return(1); - print_warning(fph, fname2, "//"); - - fprintf(fph, "\n#ifndef _%s_TYPES_H\n", p->name); - fprintf(fph, "#define _%s_TYPES_H\n\n", p->name); - fprintf(fph, "\n#ifdef _WIN32 //define something for Windows (32-bit)\n"); - fprintf(fph, "# include \"stdbool.h\"\n"); - fprintf(fph, "# define CALL __declspec( dllexport )\n"); - fprintf(fph, "#elif _WIN64 //define something for Windows (64-bit)\n"); - fprintf(fph, "# include \"stdbool.h\"\n"); - fprintf(fph, "# define CALL __declspec( dllexport ) \n"); - fprintf(fph, "#else\n"); - fprintf(fph, "# include \n"); - fprintf(fph, "# define CALL \n"); - fprintf(fph, "#endif\n\n\n"); - - gen_c_module(fph, p); - - fprintf(fph, "\n#endif // _%s_TYPES_H\n\n\n", p->name); - close_the_file(fph, "//"); - } - } - } - return(0) ; -} - -void -remove_nickname( const char *nickname, char *src, char *dst ) -{ - char tmp[NAMELEN]; - char srclo[NAMELEN]; - int n; - strcpy(tmp,make_lower_temp(nickname)) ; - strcpy(srclo, make_lower_temp(src)); - strcat(tmp,"_") ; - n = strlen(tmp) ; - if (!strncmp(tmp, srclo, n)) { - strcpy(dst,&(src[n])) ; - } else { - strcpy(dst,src) ; - } -} - -void -append_nickname( const char *nickname, char *src, char *dst ) -{ - int n ; - n = strlen(nickname) ; - if ( n > 0 ) { - sprintf(dst,"%s_%s",nickname,src) ; - } else { - strcpy(dst,src) ; - } -} - -char * dimstr( int d ) -{ - char * retval ; - if ( d == 0 ) { - retval = "" ; - } else if ( d == 1 ) { - retval = "(i1)" ; - } else if ( d == 2 ) { - retval = "(i1,i2)" ; - } else if ( d == 3 ) { - retval = "(i1,i2,i3)" ; - } else if ( d == 4 ) { - retval = "(i1,i2,i3,i4)" ; - } else if ( d == 5 ) { - retval = "(i1,i2,i3,i4,i5)" ; - } else { - retval = " REGISTRY ERROR TOO MANY DIMS " ; - } - return(retval) ; - - //strcpy(dex, ""); - //strcat(dex, "("); - //for (j = 1; j <= d; j++) { - // sprintf(tmp, "i%d%d", 0, j); - // strcat(dex, tmp); - // if (j == d) strcat(dex, ")"); else strcat(dex, ","); - //} - -} - -char * dimstr_c( int d ) -{ - char * retval ; - if ( d == 0 ) { - retval = "" ; - } else if ( d == 1 ) { - retval = "[i1]" ; - } else if ( d == 2 ) { - retval = "[i2][i1]" ; - } else if ( d == 3 ) { - retval = "[i3][i2][i1]" ; - } else if ( d == 4 ) { - retval = "[i4][i3][i2][i1]" ; - } else if ( d == 5 ) { - retval = "[i5][i4][i3][i2][i1]" ; - } else { - retval = " REGISTRY ERROR TOO MANY DIMS " ; - } - return(retval) ; -} - -void -checkOnlyReals( const char *q_mapsto, node_t * q) //, int recurselevel) -{ - node_t * r ; - - if ( q->type->type_type == DERIVED ) - { - if ( strcmp( q->type->name, "meshtype" ) ) // skip meshes - { - for ( r = q->type->fields ; r ; r = r->next ) - { - checkOnlyReals( q_mapsto, r); - } - } - - } else { // SIMPLE - - if ( strncmp(q->type->mapsto,"REAL",4) ) - { - fprintf(stderr,"Registry warning: %s contains a field (%s) in a derived type whose type is not real or double: %s\n", - q_mapsto, q->name , q->type->mapsto ) ; - } - - } - return; -} - -void -checkContainsMesh( node_t * q) //, int recurselevel) -{ - node_t * r; - - if (q->type->type_type == DERIVED) - { - if (!strcmp(q->type->name, "meshtype") || !strcmp(q->type->name, "meshmaptype")){ // is a mesh or (a bad workaround for meshmaptype which contains meshtype in "usefrom" instead of "typedef") - q->containsPtr = 1; - } - - else { - for (r = q->type->fields; r; r = r->next) - { - checkContainsMesh(r); - if (r->containsPtr) q->containsPtr = 1; - } - } - - } - - return; -} diff --git a/modules/openfast-registry/src/main.cpp b/modules/openfast-registry/src/main.cpp new file mode 100644 index 0000000000..25720a6e9e --- /dev/null +++ b/modules/openfast-registry/src/main.cpp @@ -0,0 +1,183 @@ +#include +#include + +#include "registry.hpp" +#include "templates.hpp" + +void output_template(std::string &module_name, std::string &module_nickname, bool overwrite, + bool is_template); + +const std::string usage_template = R""""( +Usage: openfast_registry registryfile [options] -or- + [-force] [-template|-registry] ModuleName ModName +Options: + -h this summary + -I look for usefrom files in directory "dir" + -O generate types files in directory "dir" + -noextrap do not generate ModName_Input_ExtrapInterp or ModName_Output_ExtrapInterp routines + -D define symbol for conditional evaluation inside registry file + -ccode generate additional code for interfacing with C/C++ + -keep do not delete temporary files from registry program + -shownodes output a listing of the nodes in registry's AST + === alternate usage for generating templates === + -template ModuleName ModName + Generate a template Module file none exists + -registry ModuleName ModName + Generate a template registry file if none exists + -force Force generating of template or registry file + (the / character can be used in place of - when specifying options) +)""""; + +int main(int argc, char *argv[]) +{ + std::cerr << std::endl; + std::cerr << "------------------------------------------------------------" << std::endl; + std::cerr << "-------------------- OpenFAST Registry ---------------------" << std::endl; + std::cerr << "------------------------------------------------------------" << std::endl; + + // Read command line arguments into a vector + std::vector arguments; + for (int i = 0; i < argc; ++i) + { + arguments.push_back(argv[i]); + } + + std::string out_dir = "."; // if no OutDir is listed, use current directory + std::string inp_file_path; + std::string module_name, module_nickname; + bool output_force_template = false; + + // Create registry object + Registry reg; + + // Loop through arguments + for (auto it = arguments.begin(); it != arguments.end(); ++it) + { + auto arg = *it; + + if ((arg.compare("-force") == 0) || (arg.compare("/force") == 0)) + { + output_force_template = true; + } + else if ((arg.compare("-ccode")) == 0 || (arg.compare("/ccode")) == 0) + { + reg.gen_c_code = true; + } + else if ((arg.compare("-noextrap")) == 0 || (arg.compare("/noextrap")) == 0) + { + reg.no_extrap_interp = true; + } + else if ((arg.compare("-shownodes")) == 0 || (arg.compare("/shownodes")) == 0) + { + } + else if ((arg.compare("-O")) == 0 || (arg.compare("/O")) == 0) + { + std::advance(it, 1); + if (it != arguments.end()) + { + out_dir = *it; + } + } + else if ((arg.compare("-I")) == 0 || (arg.compare("/I")) == 0) + { + std::advance(it, 1); + if (it != arguments.end()) + { + reg.include_dirs.push_back(*it); + } + } + else if ((arg.compare("-template")) == 0 || (arg.compare("-registry")) == 0 || + (arg.compare("/template")) == 0 || (arg.compare("/registry")) == 0) + { + std::advance(it, 1); + if (it != arguments.end()) + { + module_name = *it; + } + else + { + std::cerr << usage_template; + return EXIT_FAILURE; + } + std::advance(it, 1); + if (it != arguments.end()) + { + module_nickname = *it; + } + else + { + std::cerr << usage_template; + return EXIT_FAILURE; + } + + bool is_template = arg.substr(1).compare("template") == 0; + + output_template(module_name, module_nickname, output_force_template, is_template); + } + else if ((arg.compare("-h") == 0) || (arg.compare("/h") == 0)) + { + std::cerr << usage_template; + return EXIT_SUCCESS; + } + else + { + // Set input file path + inp_file_path = arg; + + // Add input file directory to list of directories to search + std::filesystem::path path(arg); + reg.include_dirs.push_back(path.parent_path()); + } + } + + // If input file name was not specified, exit with error + if (inp_file_path.empty()) + { + std::cerr << usage_template; + return EXIT_FAILURE; + } + + // Parse the registry file + reg.parse(inp_file_path, 0); + + // Generate module files + reg.gen_module_files(out_dir); +} + +void output_template(std::string &module_name, std::string &module_nickname, bool overwrite, + bool is_template) +{ + // Create file name depending on if template or registry + std::string fname = module_name + (is_template ? ".f90" : "_Registry.txt"); + + // If overwrite not requested and file exists, return error + if (!overwrite) + { + std::ifstream infile(fname); + if (infile.good()) + { + std::cerr << "Registry exiting. Attempt to overwrite file (" << fname; + std::cerr << ") . Move out of the way or specify -force before -template option. " + << std::endl; + exit(EXIT_FAILURE); + } + } + + // Open output file, return on error + std::ofstream outfile(fname); + if (!outfile.is_open()) + { + std::cerr << "Registry exiting. Failure opening " << fname << std::endl; + exit(EXIT_FAILURE); + } + + // Select file contents + auto contents = (is_template ? module_template : registry_template).substr(1); + + // Populate module name and module nickname + contents = std::regex_replace(contents, std::regex("ModuleName"), module_name); + contents = std::regex_replace(contents, std::regex("ModName"), module_nickname); + + // Output contents to file + outfile << contents; +} diff --git a/modules/openfast-registry/src/misc.c b/modules/openfast-registry/src/misc.c deleted file mode 100644 index 628aa05bc4..0000000000 --- a/modules/openfast-registry/src/misc.c +++ /dev/null @@ -1,710 +0,0 @@ -#include -#include -#include -#include -#ifdef _WIN32 -# define rindex(X,Y) strrchr(X,Y) -# define index(X,Y) strchr(X,Y) -# include -# define getpid _getpid -#else -# include -# include -# include -#endif - -#include "protos.h" -#include "registry.h" -#include "data.h" - -char * -dimension_with_colons( char * pre , char * tmp , node_t * p , char * post ) -{ - int i ; - if ( p == NULL ) return("") ; - if ( p->ndims <= 0 && ! p->boundary_array ) return("") ; - strcpy(tmp,"") ; - if ( pre != NULL ) strcat(tmp,pre) ; - if ( p->boundary_array ) - { - if ( ! sw_new_bdys ) { strcat( tmp,":,") ; } - if ( !strcmp( p->use , "_4d_bdy_array_" ) ) { - strcat( tmp, ":,:,:,:" ) ; /* boundary array for 4d tracer array */ - } else { - strcat( tmp, ":,:,:" ) ; /* most always have four dimensions */ - } - } - else - { - for ( i = 0 ; i < p->ndims ; i++ ) strcat(tmp,":,") ; - if ( p->node_kind & FOURD ) strcat(tmp,":,") ; /* add an extra for 4d arrays */ - tmp[strlen(tmp)-1] = '\0' ; - } - if ( post != NULL ) strcat(tmp,post) ; - return(tmp) ; -} - -char * -dimension_with_ones( char * pre , char * tmp , node_t * p , char * post ) -{ - int i ; - char r[NAMELEN],s[NAMELEN],four_d[NAMELEN] ; - char *pp ; - if ( p == NULL ) return("") ; - if ( p->ndims <= 0 && ! p->boundary_array ) return("") ; - strcpy(tmp,"") ; - if ( pre != NULL ) strcat(tmp,pre) ; - - if ( p->boundary_array ) - { - if ( ! sw_new_bdys ) { strcpy( tmp,"(1,") ; } - if ( !strcmp( p->use , "_4d_bdy_array_" ) ) { /* if a boundary array for a 4d tracer */ - strcpy(s, p->name ) ; /* copy the name and then remove everything after last underscore */ - if ((pp=rindex( s, '_' )) != NULL ) *pp = '\0' ; - sprintf( four_d, "num_%s,", s ) ; - } else { - strcpy( four_d, "" ) ; - } - - if ( !strcmp( p->use , "_4d_bdy_array_" ) ) { - sprintf( r, "1,1,1,%s", four_d ) ; /* boundary array for 4d tracer array */ - strcat( tmp, r ) ; - } else { - strcat( tmp, "1,1,1," ) ; - } - tmp[strlen(tmp)-1] = '\0' ; - } - else - { - for ( i = 0 ; i < p->ndims ; i++ ) strcat(tmp,"1,") ; - if ( p->node_kind & FOURD ) strcat(tmp,"1,") ; /* add an extra for 4d arrays */ - tmp[strlen(tmp)-1] = '\0' ; - } - if ( post != NULL ) strcat(tmp,post) ; - return(tmp) ; -} - -char * -dimension_with_ranges( char * refarg , char * pre , - int bdy , /* as defined in data.h */ - char * tmp , node_t * p , char * post , - char * nlstructname ) /* added 20020130; - provides name (with %) of structure in - which a namelist supplied dimension - should be dereference from, or "" */ -{ - int i ; - char tx[NAMELEN] ; - char r[NAMELEN],s[NAMELEN],four_d[NAMELEN] ; - int bdex, xdex, ydex, zdex ; - node_t *xdim, *ydim, *zdim ; - char *pp ; - if ( p == NULL ) return("") ; - if ( p->ndims <= 0 && !p->boundary_array ) return("") ; - strcpy(tmp,"") ; - if ( pre != NULL ) strcat(tmp,pre) ; - strcpy(r,"") ; - if ( refarg != NULL ) strcat(r,refarg) ; - - if ( p->boundary_array ) - { - if ( p->ndims > 0 ) - { - xdim = get_dimnode_for_coord( p , COORD_X ) ; - ydim = get_dimnode_for_coord( p , COORD_Y ) ; - zdim = get_dimnode_for_coord( p , COORD_Z ) ; - if ( ydim == NULL ) - { fprintf(stderr,"dimension_with_ranges: y dimension not specified for %s\n",p->name) ; return("") ; } - if ( xdim == NULL ) - { fprintf(stderr,"dimension_with_ranges: x dimension not specified for %s\n",p->name) ; return("") ; } - - xdex = xdim->dim_order ; - ydex = ydim->dim_order ; - - if ( !strcmp( p->use , "_4d_bdy_array_" ) ) { /* if a boundary array for a 4d tracer */ - strcpy(s, p->name ) ; /* copy the name and then remove everything after last underscore */ - if ((pp=rindex( s, '_' )) != NULL ) *pp = '\0' ; - sprintf( four_d, "num_%s,", s ) ; - } else { - strcpy( four_d, "" ) ; - } - if ( sw_new_bdys ) { - if ( bdy == P_XSB || bdy == P_XEB ) { bdex = ydex ; } - else if ( bdy == P_YSB || bdy == P_YEB ) { bdex = xdex ; } - else { fprintf(stderr,"REGISTRY WARNING: internal error %s %d, bdy=%d,%s,%d \n",__FILE__,__LINE__,bdy,p->name,p->boundary) ; } - if ( zdim != NULL ) { - zdex = zdim->dim_order ; - sprintf(tx,"%ssm3%d:%sem3%d,%ssm3%d:%sem3%d,%sspec_bdy_width,%s", r,bdex,r,bdex,r,zdex,r,zdex,r,four_d ) ; - } else { - sprintf(tx,"%ssm3%d:%sem3%d,1,%sspec_bdy_width,%s", r,bdex,r,bdex,r,four_d ) ; - } - } else { - if ( zdim != NULL ) { - zdex = zdim->dim_order ; - sprintf(tx,"max(%sed3%d,%sed3%d),%ssd3%d:%sed3%d,%sspec_bdy_width,4,%s", r,xdex,r,ydex,r,zdex,r,zdex,r,four_d ) ; - } else { - sprintf(tx,"max(%sed3%d,%sed3%d),1,%sspec_bdy_width,4,%s", r,xdex,r,ydex,r,four_d ) ; - } - } - } - else - { - sprintf(tx,"%sspec_bdy_width,",r ) ; - } - strcat(tmp,tx) ; - } - else - { - for ( i = 0 ; i < p->ndims ; i++ ) - { - range_of_dimension( r, tx , i , p , nlstructname ) ; - strcat(tmp,tx) ; - strcat(tmp,",") ; - } - } - tmp[strlen(tmp)-1] = '\0' ; - if ( post != NULL ) strcat(tmp,post) ; - - return(tmp) ; -} - -void -range_of_dimension ( char * r , char * tx , int i , node_t * p , char * nlstructname ) -{ - char s[NAMELEN], e[NAMELEN] ; - - get_elem( r , nlstructname , s , i , p , 0 ) ; - get_elem( r , nlstructname , e , i , p , 1 ) ; - sprintf(tx,"%s:%s", s , e ) ; - -} - -char * -index_with_firstelem( char * pre , char * dref , int bdy , /* as defined in data.h */ - char * tmp , node_t * p , char * post ) -{ - int i ; - char tx[NAMELEN] ; - int bdex, xdex, ydex, zdex = 0 ; - node_t *xdim, *ydim, *zdim ; - char r[NAMELEN] ; - - if ( p == NULL ) return("") ; - if ( p->ndims <= 0 ) return("") ; - strcpy(tmp,"") ; - if ( pre != NULL ) strcat(tmp,pre) ; - - strcpy(r,"") ; - if ( dref != NULL ) strcat(r,dref) ; - - if ( p->boundary_array ) - { - if ( sw_new_bdys ) { - - xdim = get_dimnode_for_coord( p , COORD_X ) ; - ydim = get_dimnode_for_coord( p , COORD_Y ) ; - zdim = get_dimnode_for_coord( p , COORD_Z ) ; - if ( ydim == NULL ) - { fprintf(stderr,"dimension_with_ranges: y dimension not specified for %s\n",p->name) ; return("") ; } - if ( xdim == NULL ) - { fprintf(stderr,"dimension_with_ranges: x dimension not specified for %s\n",p->name) ; return("") ; } - - xdex = xdim->dim_order ; - ydex = ydim->dim_order ; - - if ( bdy == P_XSB || bdy == P_XEB ) { bdex = ydex ; } - else if ( bdy == P_YSB || bdy == P_YEB ) { bdex = xdex ; } - else { fprintf(stderr,"REGISTRY WARNING: internal error %s %d \n",__FILE__,__LINE__) ; } - if ( p->ndims > 0 ) - { - if ( !strcmp( p->use , "_4d_bdy_array_" ) ) { - sprintf(tmp,"%ssm3%d,%ssm3%d,1,1", r,bdex,r,zdex ) ; - } else { - sprintf(tmp,"%ssm3%d,%ssm3%d,1", r,bdex,r,zdex ) ; - } - } - else - { - sprintf(tx,"1," ) ; - strcat(tmp,tx) ; - } - - } else { - if ( p->ndims > 0 ) - { - if ( !strcmp( p->use , "_4d_bdy_array_" ) ) { - strcat(tmp,"1,1,1,1,1,") ; - } else { - strcat(tmp,"1,1,1,1,") ; - } - } - else - { - sprintf(tx,"1," ) ; - strcat(tmp,tx) ; - } - } - } - else - { - for ( i = 0 ; i < p->ndims ; i++ ) - { - get_elem( dref, "", tx, i, p , 0 ) ; - strcat( tmp, tx ) ; - strcat(tmp,",") ; - } - } - tmp[strlen(tmp)-1] = '\0' ; /* remove trailing comma */ - if ( post != NULL ) strcat(tmp,post) ; - return(tmp) ; -} - -void -get_elem ( char * structname , char * nlstructname , char * tx , int i , node_t * p , int first_last ) -{ - char dref[NAMELEN], nlstruct[NAMELEN] ; - char d, d1 ; - - if ( structname == NULL ) { strcpy( dref, "" ) ;} - else { strcpy( dref, structname ) ; } - if ( nlstructname == NULL ) { strcpy( nlstruct, "" ) ;} - else { strcpy( nlstruct, nlstructname ) ; } - if ( p->dims[i] != NULL ) - { - switch ( p->dims[i]->len_defined_how ) - { - case (DOMAIN_STANDARD) : - { - char *ornt ; - if ( p->proc_orient == ALL_X_ON_PROC ) ornt = "x" ; - else if ( p->proc_orient == ALL_Y_ON_PROC ) ornt = "y" ; - else ornt = "" ; - - switch( p->dims[i]->coord_axis ) - { - case(COORD_X) : d = 'i' ; d1 = 'x' ; break ; - case(COORD_Y) : d = 'j' ; d1 = 'y' ; break ; - case(COORD_Z) : d = 'k' ; d1 = 'z' ; break ; - default : break ; - } - - if ( p->dims[i]->subgrid ) - { - if ( first_last == 0 ) { /*first*/ - sprintf(tx,"(%ssm3%d%s-1)*%ssr_%c+1",dref,p->dims[i]->dim_order,ornt,dref,d1) ; - }else{ /*last*/ - sprintf(tx,"%sem3%d%s*%ssr_%c" ,dref,p->dims[i]->dim_order,ornt,dref,d1) ; - } - } - else - { - sprintf(tx,"%s%cm3%d%s",dref,first_last==0?'s':'e',p->dims[i]->dim_order,ornt) ; - } - } - break ; - case (NAMELIST) : - if ( first_last == 0 ) { if ( !strcmp( p->dims[i]->assoc_nl_var_s , "1" ) ) { - sprintf(tx,"%s",p->dims[i]->assoc_nl_var_s) ; - } else { - sprintf(tx,"%s%s%s",nlstructname,structname,p->dims[i]->assoc_nl_var_s) ; - } - } - else { sprintf(tx,"%s%s%s",nlstructname,structname,p->dims[i]->assoc_nl_var_e) ; } - break ; - case (CONSTANT) : - if ( first_last == 0 ) { sprintf(tx,"%d",p->dims[i]->coord_start) ; } - else { sprintf(tx,"%d",p->dims[i]->coord_end) ; } - break ; - default : break ; - } - } - else - { - fprintf(stderr,"WARNING: %s %d: something wrong with internal representation for dim %d\n",__FILE__,__LINE__,i) ; - } -} - -char * -declare_array_as_pointer( char * tmp , node_t * p ) -{ - strcpy( tmp , "" ) ; - if ( p != NULL ) { -#ifdef USE_ALLOCATABLES - if ( p->ndims > 0 || p->boundary_array ) strcpy ( tmp, ",ALLOCATABLE" ) ; -#else - if ( p->ndims > 0 || p->boundary_array ) strcpy ( tmp, ",POINTER" ) ; -#endif - } - return(tmp); -} - -char * -field_type( char * tmp , node_t * p ) -{ - if ( p == NULL ) { - strcpy( tmp , "" ) ; - } else if ( p->type == NULL ) { - strcpy( tmp , "" ) ; - } else if ( p->type->type_type == SIMPLE ) { - strcpy( tmp , p->type->name ) ; - } else { - sprintf( tmp , "TYPE(%s)", p->type->name ) ; - } - return( tmp ) ; -} - -char * -field_name( char * tmp , node_t * p , int tag ) -{ - if ( p == NULL ) return("") ; - return( tmp ) ; -} - -char * -field_name_bdy( char * tmp , node_t * p , int tag, int bdy ) -{ - if ( p == NULL ) return("") ; - if ( tag < 1 ) - { - strcpy(tmp,p->name) ; - } - else - { - sprintf(tmp,"%s_%d",p->name,tag) ; - } - return( tmp ) ; -} - -static char *emp_str = "" ; -static char *xs_str = "xs" ; -static char *xe_str = "xe" ; -static char *ys_str = "ys" ; -static char *ye_str = "ye" ; - -char * -bdy_indicator( int bdy ) -{ - char * res ; - res = emp_str ; - if ( bdy == P_XSB ) { res = xs_str ; } - else if ( bdy == P_XEB ) { res = xe_str ; } - else if ( bdy == P_YSB ) { res = ys_str ; } - else if ( bdy == P_YEB ) { res = ye_str ; } - return(res) ; -} - -int -print_warning( FILE * fp , char * fname, char comment[] ) -{ -fprintf(fp,"%s!STARTOFREGISTRYGENERATEDFILE '%s'\n", comment, fname) ; -fprintf(fp,"%s!\n", comment) ; -fprintf(fp,"%s! WARNING This file is generated automatically by the FAST registry.\n", comment) ; -fprintf(fp,"%s! Do not edit. Your changes to this file will be lost.\n", comment) ; -fprintf(fp,"%s!\n", comment) ; -return(0) ; -} - -void -close_the_file( FILE * fp, char comment[] ) -{ -fprintf(fp,"%s!ENDOFREGISTRYGENERATEDFILE\n",comment) ; -fclose(fp) ; -} - -int -make_entries_uniq ( char * fname ) -{ - char tempfile[NAMELEN] ; - /* Had to increase size for SOA from 4096 to 7000 */ - char commline[7000] ; - sprintf(tempfile,"regtmp1%d",getpid()) ; - sprintf(commline,"%s < %s > %s ; %s %s %s ", - UNIQSORT,fname,tempfile, - MVCOMM,tempfile,fname ) ; - return(system(commline)) ; -} - -int -add_warning ( char * fname ) -{ - FILE * fp ; - char tempfile[NAMELEN] ; - char tempfile1[NAMELEN] ; - /* Had to increase size for SOA from 4096 to 7000 */ - char commline[7000] ; - sprintf(tempfile,"regtmp1%d",getpid()) ; - sprintf(tempfile1,"regtmp2%d",getpid()) ; - if (( fp = fopen( tempfile, "w" )) == NULL ) return(1) ; - print_warning(fp,tempfile, "") ; - close_the_file(fp, "") ; - sprintf(commline,"%s %s %s > %s ; %s %s %s ; %s %s ", - CATCOMM,tempfile,fname,tempfile1, - MVCOMM,tempfile1,fname, - RMCOMM,tempfile) ; - return(system(commline)) ; -} - -/* DESTRUCTIVE */ -char * -make_upper_case ( char * str ) -{ - char * p ; - if ( str == NULL ) return (NULL) ; - for ( p = str ; *p ; p++ ) *p = toupper(*p) ; - return(str) ; -} - -/* DESTRUCTIVE */ -char * -make_lower_case ( char * str ) -{ - char * p ; - if ( str == NULL ) return (NULL) ; - for ( p = str ; *p ; p++ ) *p = tolower(*p) ; - return(str) ; -} - -/* Routines for keeping typedef history -ajb */ - -static int NumTypeDefs ; -static char typedefs[MAX_TYPEDEFS][NAMELEN] ; - -int -init_typedef_history() -{ - NumTypeDefs = 0 ; - return(0) ; -} - -int -get_num_typedefs() -{ - return( NumTypeDefs ) ; -} - -char * -get_typename_i(int i) -{ - if ( i >= 0 && i < NumTypeDefs ) return( typedefs[i] ) ; - return(NULL) ; -} - -int -add_typedef_name ( char * name ) -{ - if ( name == NULL ) return(1) ; - if ( get_typedef_name ( name ) == NULL ) - { - if ( NumTypeDefs >= MAX_TYPEDEFS ) return(1) ; - strcpy( typedefs[NumTypeDefs++] , name ) ; - } - return(0) ; -} - -char * -get_typedef_name ( char * name ) -{ - int i ; - if ( name == NULL ) return(NULL) ; - for ( i = 0 ; i < NumTypeDefs ; i++ ) - { - if ( !strcmp(name,typedefs[i]) ) return( typedefs[i] ) ; - } - return(NULL) ; -} - -int -associated_with_4d_array( node_t * p ) -{ - int res = 0 ; - node_t * possble ; - char * last_underscore ; - char name_copy[128] ; - if ( p != NULL ) - { - /* check this variable and see if it is a boundary variable that is associated with a 4d array */ - strcpy( name_copy, p->name ) ; - if (( last_underscore = rindex( name_copy , '_' )) != NULL ) { - if ( !strcmp( last_underscore , "_b" ) || !strcmp( last_underscore , "_bt" ) ) { - *last_underscore = '\0' ; - if (( possble = get_entry( name_copy , Domain.fields )) != NULL ) { - res = possble->node_kind & FOURD ; - } - } - } - } - return(res) ; -} - -char * -array_size_expression ( char * refarg , char * pre , - int bdy , /* as defined in data.h */ - char * tmp , node_t * p , char * post , - char * nlstructname ) /* provides name (with %) of structure in - which a namelist supplied dimension - should be dereference from, or "" */ -{ - int i ; - char tx[NAMELEN] ; - char r[NAMELEN],s[NAMELEN],four_d[NAMELEN] ; - int bdex, xdex, ydex, zdex ; - node_t *xdim, *ydim, *zdim ; - char *pp ; - if ( p == NULL ) return("") ; - if ( p->ndims <= 0 && !p->boundary_array ) return("") ; - strcpy(tmp,"") ; - if ( pre != NULL ) strcat(tmp,pre) ; - strcpy(r,"") ; - if ( refarg != NULL ) strcat(r,refarg) ; - - if ( p->boundary_array ) - { - if ( p->ndims > 0 ) - { - xdim = get_dimnode_for_coord( p , COORD_X ) ; - ydim = get_dimnode_for_coord( p , COORD_Y ) ; - zdim = get_dimnode_for_coord( p , COORD_Z ) ; - if ( ydim == NULL ) - { fprintf(stderr,"dimension_with_ranges: y dimension not specified for %s\n",p->name) ; return("") ; } - if ( xdim == NULL ) - { fprintf(stderr,"dimension_with_ranges: x dimension not specified for %s\n",p->name) ; return("") ; } - - xdex = xdim->dim_order ; - ydex = ydim->dim_order ; - - if ( !strcmp( p->use , "_4d_bdy_array_" ) ) { /* if a boundary array for a 4d tracer */ - strcpy(s, p->name ) ; /* copy the name and then remove everything after last underscore */ - if ((pp=rindex( s, '_' )) != NULL ) *pp = '\0' ; - sprintf( four_d, "*num_%s,", s ) ; - } else { - strcpy( four_d, "" ) ; - } - if ( sw_new_bdys ) { - if ( bdy == P_XSB || bdy == P_XEB ) { bdex = ydex ; } - else if ( bdy == P_YSB || bdy == P_YEB ) { bdex = xdex ; } - else { fprintf(stderr,"REGISTRY WARNING: internal error %s %d, bdy=%d,%s,%d \n",__FILE__,__LINE__,bdy,p->name,p->boundary) ; } - if ( zdim != NULL ) { - zdex = zdim->dim_order ; - sprintf(tx,"(%sem3%d-%ssm3%d+1)*(%sem3%d-%ssm3%d+1)*(%sspec_bdy_width)%s", r,bdex,r,bdex,r,zdex,r,zdex,r,four_d ) ; - } else { - sprintf(tx,"(%sem3%d-%ssm3%d+1)*(%sspec_bdy_width)%s", r,bdex,r,bdex,r,four_d ) ; - } - } else { - if ( zdim != NULL ) { - zdex = zdim->dim_order ; - sprintf(tx,"max(%sed3%d,%sed3%d)*(%sed3%d-%ssd3%d+1)*%sspec_bdy_width*4*%s", r,xdex,r,ydex,r,zdex,r,zdex,r,four_d ) ; - } else { - sprintf(tx,"max(%sed3%d,%sed3%d)*%sspec_bdy_width*4*%s", r,xdex,r,ydex,r,four_d ) ; - } - if ( tx[strlen(tx)-1] == '*' ) tx[strlen(tx)-1] = '\0' ; /* chop trailing * if four_d is "" */ - } - } - else - { - sprintf(tx,"%sspec_bdy_width,",r ) ; - } - strcat(tmp,tx) ; - } - else - { - for ( i = 0 ; i < p->ndims ; i++ ) - { - dimension_size_expression( r, tx , i , p , nlstructname ) ; - strcat(tmp,tx) ; - strcat(tmp,")*(") ; - } - } - if ( tmp[strlen(tmp)-1] == '(' ) { - tmp[strlen(tmp)-3] = '\0' ; /* get rid of trailing )*( */ - } else if ( tmp[strlen(tmp)-1] == ',' ) { - tmp[strlen(tmp)-1] = '\0' ; - } - if ( post != NULL ) strcat(tmp,post) ; - - return(tmp) ; -} - -void -dimension_size_expression ( char * r , char * tx , int i , node_t * p , char * nlstructname ) -{ - char s[NAMELEN], e[NAMELEN] ; - - get_elem( r , nlstructname , s , i , p , 0 ) ; - get_elem( r , nlstructname , e , i , p , 1 ) ; - sprintf(tx,"((%s)-(%s)+1)", e , s ) ; - -} - -#ifdef FUTURE -void -reset_mask ( unsigned int * mask , int e ) -{ - int w ; - unsigned int m, n ; - - w = e / (8*sizeof(int)-1) ; - n = 1 ; - m = ~( n << e % (8*sizeof(int)-1) ) ; - if ( w >= 0 && w < IO_MASK_SIZE ) { - mask[w] &= m ; - } -} - -void -set_mask ( unsigned int * mask , int e ) -{ - int w ; - unsigned int m, n ; - - w = e / (8*sizeof(int)-1) ; - n = 1 ; - m = ( n << e % (8*sizeof(int)-1) ) ; - if ( w >= 0 && w < IO_MASK_SIZE ) { - mask[w] |= m ; - } -} - -int -get_mask ( unsigned int * mask , int e ) -{ - int w ; - unsigned int m, n ; - - w = e / (8*sizeof(int)-1) ; /* 8 is number of bits per byte */ - if ( w >= 0 && w < IO_MASK_SIZE ) { - m = mask[w] ; - n = ( 1 << e % (8*sizeof(int)-1) ) ;; - return ( (m & n) != 0 ) ; - } else { - return(0) ; - } -} -#endif - -#if 0 -main() -{ - unsigned int m[5] ; - int i, ii ; - - for ( i = 0 ; i < 5*32 ; i++ ) { - for ( ii = 0 ; ii < 5 ; ii++ ) { m[ii] = 0xffffffff ; } - reset_mask( m, i ) ; - for ( ii = 4 ; ii >= 0 ; ii-- ) { printf(" %08x ", m[ii]) ; } - printf("\n") ; - } - - for ( i = 0 ; i < 5*32 ; i++ ) { - for ( ii = 0 ; ii < 5 ; ii++ ) { m[ii] = 0x0 ; } - set_mask( m, i ) ; - for ( ii = 4 ; ii >= 0 ; ii-- ) { printf(" %08x ", m[ii]) ; } - printf("\n") ; - } - - for ( ii = 0 ; ii < 5 ; ii++ ) { m[ii] = 0x0 ; } - set_mask( m, 82 ) ; - for ( i = 0 ; i < 5*32 ; i++ ) { - printf("%d %0d\n",i,get_mask(m,i) ) ; - } -} -#endif diff --git a/modules/openfast-registry/src/my_strtok.c b/modules/openfast-registry/src/my_strtok.c deleted file mode 100644 index ec7f479a99..0000000000 --- a/modules/openfast-registry/src/my_strtok.c +++ /dev/null @@ -1,139 +0,0 @@ -#include -#include -#include "registry.h" -#include "protos.h" -#include "ctype.h" - - -/* work sort of like strtok but mind quote chars */ -static char * tokpos = NULL ; -char * -my_strtok( char * s1 ) -{ - char *p, *retval ; - int state ; - state = 0 ; - retval = NULL ; - if ( s1 == NULL && tokpos == NULL ) return( NULL ) ; - if ( s1 != NULL ) tokpos = s1 ; - for ( p = tokpos ; *p ; p++ ) - { -/* check for non-printable characters in input. this can happen cutting and pasting from a - MS office document or PDF */ - - if ( !( (' ' <= *p && *p <= '~') || *p == '\t' ) ) { - fprintf(stderr,"Registry error: FATAL: Invalid character '%c' (maybe invisible: can happen if you cut-and-paste from a Office doc or PDF)\n",*p) ; - exit(2) ; - } - if ( state == 0 && (*p == ' ' || *p == '\t') ) continue ; - if ( state == 0 && !(*p == ' ' || *p == '\t') ) { state = 1 ; retval = p ; } ; - if ( state == 1 && (*p == '"') ) { state = 2 ; } - else if ( state == 2 && (*p == '"') ) { state = 1 ; } - if ( state == 1 && (*p == ' ' || *p == '\t') ) { *p = '\0' ; p++ ; break ; } - } - tokpos = p ; - return( retval ) ; -} - - -/* posix like rentrant strtok; not quote safe, and not quite strtok -- new version; skips multi delims */ -char * -strtok_rentr( char * s1 , char * s2, char ** tokpos ) -{ - char *p, *q, *retval ; - int match ; - retval = NULL ; - if ( s1 == NULL && s2 == NULL ) return( NULL ) ; - if ( s1 != NULL ) { *tokpos = s1 ; } - if ( **tokpos ) retval = *tokpos ; - for ( p = *tokpos ; *p ; p++ ) - { - for ( q = s2 ; *q ; q++ ) - { - if ( *p == *q ) { *p = '\0' ; p++ ; goto foundit ; } - } - } -foundit: -/* skip over multi-delims */ - for ( ; *p ; p++ ) - { - match = 0 ; - for ( q = s2 ; *q ; q++ ) - { - if ( *p == *q ) { *p = '\0' ; match++ ; } - } - if ( match == 0 ) { break ; } - } - *tokpos = p ; - return( retval ) ; -} - -#if 0 -/* posix like rentrant strtok; not quote safe, and not quite strtok -- won't skip over multiple delims */ -char * -strtok_rentr( char * s1 , char * s2, char ** tokpos ) -{ - char *p, *q, *retval ; - retval = NULL ; - if ( s1 == NULL && s2 == NULL ) return( NULL ) ; - if ( s1 != NULL ) { *tokpos = s1 ; } - if ( **tokpos ) retval = *tokpos ; - for ( p = *tokpos ; *p ; p++ ) - { - for ( q = s2 ; *q ; q++ ) - { - if ( *p == *q ) { *p = '\0' ; p++ ; goto foundit ; } - } - } -foundit: - *tokpos = p ; - return( retval ) ; -} -#endif - -char * -make_lower( char * s1 ) -{ - char * p ; - int state ; - state = 0 ; - for ( p = s1 ; *p ; p++ ) - { - if ( state == 0 && *p == '"' ) state = 1 ; - else if ( state == 1 && *p == '"' ) state = 0 ; - if ( state == 0 ) - { - *p = tolower(*p) ; - } - } - return(s1) ; -} - -/* do not store the result of this routine */ -#define LENRING 500 -static char t[LENRING][NAMELEN] ; -static int tcurs = 0 ; -char * -make_lower_temp( const char * s1 ) -{ - const char * p; - char *q ; - int state ; - state = 0 ; - for ( p = s1, q = t[tcurs] ; *p ; p++, q++ ) - { - if ( state == 0 && *p == '"' ) state = 1 ; - else if ( state == 1 && *p == '"' ) state = 0 ; - *q = *p ; - if ( state == 0 ) - { - *q = tolower(*p) ; - } - } - *q = '\0' ; - q = t[tcurs] ; - tcurs = (tcurs+1)%LENRING ; - return(q) ; -} - - diff --git a/modules/openfast-registry/src/protos.h b/modules/openfast-registry/src/protos.h deleted file mode 100644 index 1c8e06c000..0000000000 --- a/modules/openfast-registry/src/protos.h +++ /dev/null @@ -1,189 +0,0 @@ -#ifndef PROTOS_H -#include "registry.h" -#include "data.h" - -void substitute( char * str , char * match , char * replace, char * result ); - -int init_dim_table() ; -char * make_lower( char * s1 ) ; -char * make_lower_temp( const char * s1 ) ; -int check_dimspecs(); -int init_parser(); -int is_a_fast_interface_type( char *str ); -int pre_parse( char * dir, FILE * infile, FILE * outfile, int usefrom_sw ); -int reg_parse( FILE * infile ) ; -int must_have_real_or_double( char *str ); -int set_dim_len ( char * dimspec , node_t * dim_entry ) ; -int set_dim_order ( char * dimorder , node_t * dim_entry ) ; -int set_dim_orient ( char * dimorient , node_t * dim_entry ) ; -int add_node_to_end ( node_t * node , node_t ** list ) ; -int add_node_to_beg ( node_t * node , node_t ** list ) ; -int add_node_to_end_4d ( node_t * node , node_t ** list ) ; -int init_type_table() ; -int set_state_type ( char * , node_t *, node_t *, node_t * ) ; -int set_state_dims ( char * dims , node_t * node ) ; -int set_ctrl ( char * ctrl , node_t * node ) ; -int gen_state_struct ( char * fname ) ; - -#if 1 -int show_node( node_t * p ) ; -int show_node1( node_t * p, int indent ) ; -void show_nodelist( node_t * p ) ; -void show_nodelist1( node_t * p , int indent ) ; -#endif - -void gen_c_module( FILE * fph, node_t * ModName ); - -int gen_state_struct ( char * fname ) ; -int gen_decls ( FILE * fp , node_t * node , int sw_ranges, int sw_point , int mask , int layer ) ; -int gen_state_subtypes ( char * fname ) ; -int gen_state_subtypes1 ( FILE * fp , node_t * node , int sw_ranges, int sw_point , int mask ) ; -int print_warning( FILE * fp , char * fname, char * comment ) ; -void close_the_file( FILE * fp, char * comment ) ; -int make_entries_uniq ( char * fname ) ; -int add_warning ( char * fname ) ; - -int init_modname_table(); -node_t * get_type_entry ( char * typename ) ; -node_t * get_modname_entry ( char * modname ) ; -node_t * get_rconfig_entry( char * name ) ; -node_t * get_entry ( char * name , node_t * node ) ; -node_t * get_entry_r ( char * name , char * use , node_t * node ) ; -node_t * get_dim_entry( char *s, int ) ; -node_t * new_node ( int kind ) ; - -node_t * get_4d_entry ( char * name ) ; -node_t * get_dimnode_for_coord ( node_t * node , int coord_axis ) ; -int get_index_for_coord ( node_t * node , int coord_axis ) ; - -char * my_strtok( char * s1 ) ; -char * strtok_rentr( char * s1 , char * s2, char ** tokpos ) ; - -char * bdy_indicator( int bdy ) ; -char * make_upper_case ( char * str ); -char * make_lower_case ( char * str ); - -char * field_name( char * tmp, node_t * p , int tag ) ; -char * field_name_bdy( char * tmp, node_t * p , int tag, int bdy ) ; -char * dimension_with_colons( char * pre, char * tmp, node_t * p, char * post) ; -char * dimension_with_ones( char * pre, char * tmp, node_t * p, char * post) ; -char * dimension_with_ranges( char * ref , char * pre, int bdy , char * tmp, node_t * p, char * post, char * nlstructname ) ; -char * arrray_size_expression( char * refarg , char * pre , int bdy , char * tmp , node_t * p , char * post , char * nlstructname ) ; -char * index_with_firstelem( char * pre , char * dref , int bdy , char * tmp , node_t * p , char * post ) ; - -char * declare_array_as_pointer( char * tmp, node_t * p ) ; -char * field_type( char * tmp , node_t * p ) ; - -/* For typedef history -ajb */ -int init_typedef_history() ; -int add_typedef_name ( char * name ) ; -int get_num_typedefs() ; -char * get_typedef_name ( char * name ) ; -char * get_typename_i(int i) ; - -int gen_alloc ( char * dirname ) ; -int gen_alloc1 ( char * dirname ) ; -int gen_alloc2 ( FILE * fp , char * structname , node_t * node, int *j, int *iguy, int *fraction, int numguys, int frac, int sw ); - -int gen_module_files ( char * dirname, char * prog_ver ); -int gen_module_state_description ( char * dirname ) ; -int gen_module_state_description1 ( FILE * fp , node_t * node ) ; - -void remove_nickname( const char *nickname, char *src, char *dst ); -void append_nickname( const char *nickname, char *src, char *dst ); -char * dimstr_c( int d ); -void checkOnlyReals( const char *q_mapsto, node_t * q); -void checkContainsMesh(node_t * q); - -int gen_scalar_indices ( char * dirname ) ; -int gen_scalar_indices1 ( FILE * fp, FILE ** fp2 ) ; - -int gen_actual_args ( char * dirname ) ; -int gen_dummy_args ( char * dirname ) ; -int gen_dummy_decls ( char * dn ) ; -int gen_args ( char * dirname , int sw ) ; -int gen_args1 ( FILE * fp , char * outstr, char * structname , node_t * node , int *linelen , int sw , int deep ) ; - -int gen_scalar_derefs ( char * dirname ) ; -int scalar_derefs ( char * dirname ) ; -int scalar_derefs1 ( FILE * fp , node_t * node, int direction ) ; - -int set_mark ( int val , node_t * lst ) ; -int set_mark_4d ( int val , node_t * lst ) ; - -int gen_i1_decls ( char * dn ) ; -int gen_get_nl_config ( char * dirname ) ; - -int gen_config_assigns ( char * dirname ) ; -int gen_config_reads ( char * dirname ) ; - -char * set_mem_order( node_t * node , char * str , int n ) ; - -int gen_wrf_io ( char * dirname ) ; -int set_dim_strs ( node_t *node , char ddim[3][2][NAMELEN], char mdim[3][2][NAMELEN], char pdim[3][2][NAMELEN] , char * prepend, int sw_allow_stagger ) ; -int set_dim_strs2 ( node_t *node , char ddim[3][2][NAMELEN], char mdim[3][2][NAMELEN], char pdim[3][2][NAMELEN] , char * prepend, int sw_disregard_stag ) ; -int set_dim_strs3 ( node_t *node , char ddim[3][2][NAMELEN], char mdim[3][2][NAMELEN], char pdim[3][2][NAMELEN] , char * prepend, int sw_disregard_stag ) ; -int gen_wrf_io2 ( FILE * fp , char * fname , char * structname , char * fourdname , node_t * node , int sw_io ) ; - -int gen_namelist_defines ( char * dirname , int sw_dimension ) ; -int gen_namelist_defaults ( char * dirname ) ; -int gen_namelist_script ( char * dirname ) ; - -int gen_model_data_ord ( char * dirname ) ; - -void get_elem ( char * structname , char * nlstructname , char * tx , int i , node_t * p , int first_last ) ; - -int associated_with_4d_array( node_t * p ) ; - - -/* PGI Addition to resolve non-prototype function warnings */ -char * array_size_expression ( char *, char *, int, char *, node_t *, char * ,char * ); -void range_of_dimension ( char *, char * , int, node_t *, char * ); -void dimension_size_expression ( char *, char *, int, node_t *, char *); -int gen_alloc_count ( char *); -int gen_alloc_count1 ( char *); -int gen_ddt_write ( char * ); -int gen_ddt_write1 ( FILE *, char *, node_t *); -int gen_dealloc ( char * ); -int gen_dealloc1 ( char * ); -int gen_dealloc2 ( FILE *, char *, node_t *); -int gen_scalar_tables ( FILE *); -int gen_scalar_tables_init ( FILE *); -int gen_scalar_indices_init ( FILE *); -int hash(char *); -int create_ht( char *** p ); -int gen_nest_interp1 ( FILE *, node_t *, char *, int, int ); -int gen_packs_halo ( FILE *fp , node_t *p, char *shw, int xy /* 0=y,1=x */ , int pu /* 0=pack,1=unpack */, char * packname, char * commname ); -int gen_packs ( FILE *fp , node_t *p, int shw, int xy /* 0=y,1=x */ , int pu /* 0=pack,1=unpack */, char * packname, char * commname ); -int gen_periods ( char * dirname , node_t * periods ); -int gen_swaps ( char * dirname , node_t * swaps ); -int gen_cycles ( char * dirname , node_t * cycles ); -int gen_xposes ( char * dirname ); -int gen_comm_descrips ( char * dirname ); -int gen_shift ( char * dirname ); -int gen_datacalls ( char * dirname ); -int gen_nest_packing ( char * dirname ); -int gen_nest_pack ( char * dirname ); -int gen_nest_unpack ( char * dirname ); -int gen_nest_packunpack ( FILE *fp , node_t * node , int dir, int down_path ); -int count_fields ( node_t * node , int * d2 , int * d3 , char * fourd_names, int down_path ); -int gen_debug ( char * dirname ); - -void reset_mask ( unsigned int * mask , int e ) ; -void set_mask ( unsigned int * mask , int e ) ; -int get_mask ( unsigned int * mask , int e ) ; - -char * fast_interface_type_shortname ( char * ) ; -char * std_case( char * ) ; - -char * dimstr( int ) ; - -char * C_type ( char * ) ; -char * c_types_binding( char *s ); -char * assoc_or_allocated( node_t * r ); -int is_pointer( node_t * r ); -int has_deferred_dim( node_t * node, int noisy ); - -#define PROTOS_H -#endif - diff --git a/modules/openfast-registry/src/reg_parse.c b/modules/openfast-registry/src/reg_parse.c deleted file mode 100644 index ccacae580c..0000000000 --- a/modules/openfast-registry/src/reg_parse.c +++ /dev/null @@ -1,814 +0,0 @@ -#include -#include -#include -#include -#ifdef _WIN32 -# define rindex(X,Y) strrchr(X,Y) -# define index(X,Y) strchr(X,Y) -#else -# include -#endif - -#include "registry.h" -#include "protos.h" -#include "data.h" -#include "sym.h" - -/* fields for state entries (note, these get converted to field entries in the - reg_parse routine; therefore, only TABLE needs to be looked at */ -#define TABLE 0 - -/* fields for field entries (TABLE="typedef" and, with some munging, TABLE="state") */ -#define FIELD_MODNAME 1 -#define FIELD_OF 2 -#define FIELD_TYPE 3 -#define FIELD_SYM 4 -#define FIELD_DIMS 5 -#define FIELD_INIVAL 6 -#define FIELD_CTRL 7 -#define FIELD_DESCRIP 8 -#define FIELD_UNITS 9 - -#define F_MODNAME 0 -#define F_OF 1 -#define F_TYPE 2 -#define F_SYM 3 -#define F_DIMS 4 -#define F_INIVAL 5 -#define F_CTRL 6 -#define F_DESCRIP 7 -#define F_UNITS 8 - -/* fields for dimension entries (TABLE="dimspec") */ -#define DIM_NAME 1 -//#define DIM_ORDER 2 -#define DIM_SPEC 2 - -#define INLN_SIZE 8000 -#define PARSELINE_SIZE 8000 - -int isNum( char c ) -{ - if ( c < '0' || c > '9' ) return 0; - return 1 ; -} - -int -pre_parse( char * dir, FILE * infile, FILE * outfile, int usefrom_sw ) -{ - /* Decreased size for SOA from 8192 to 8000--double check if necessary, Manish Shrivastava 2010 */ - char inln[INLN_SIZE], parseline[PARSELINE_SIZE], parseline_save[PARSELINE_SIZE] ; - char *p, *q, *p1, *p2 ; - char *tokens[MAXTOKENS] ; - int i, ifile ; - int ifdef_stack_ptr = 0 ; - int ifdef_stack[100] ; - int inquote, retval ; - int foundit ; - - ifdef_stack[0] = 1 ; - retval = 0 ; - - parseline[0] = '\0' ; - while ( fgets ( inln , INLN_SIZE , infile ) != NULL ) - { -/*** preprocessing directives ****/ - /* look for an include statement */ - if (( p = index( inln , '\n' )) != NULL ) *p = '\0' ; /* discard newlines */ - if (( p = index( inln , '\r' )) != NULL ) *p = '\0' ; /* discard carriage returns (happens on Windows)*/ - for ( p = inln ; ( *p == ' ' || *p == '\t' ) && *p != '\0' ; p++ ) ; - p1 = make_lower_temp(p) ; - if ( (!strncmp( p1 , "include", 7 ) || !strncmp( p1, "usefrom", 7 )) && ! ( ifdef_stack_ptr >= 0 && ! ifdef_stack[ifdef_stack_ptr] ) ) - { - FILE *include_fp ; - char include_file_name[NAMELEN] ; - char include_file_name_tmp[NAMELEN] ; - int checking_for_usefrom = !strncmp( p1, "usefrom", 7 ) ; -//fprintf(stderr,"checking_for_usefrom %d |%s|\n",checking_for_usefrom,p1) ; - - p += 7 ; for ( ; ( *p == ' ' || *p == '\t' ) && *p != '\0' ; p++ ) ; - if ( strlen( p ) > 127 ) { fprintf(stderr,"Registry warning: invalid include file name: %s\n", p ) ; } - else { -/* look in a few places for valid include files */ - foundit = 0 ; - - // See if it might be in the current directory - sprintf( include_file_name , "%s", p ) ; // first name in line from registry file, without the include or usefrom - for ( p2 = include_file_name ; !( *p2 == ' ' || *p2 == '\t' || *p2 == '\n' ) && *p2 != '\0' ; p2++ ) {} - *p2 = '\0' ; // drop tailing white space - if ( (q=index(include_file_name,'\n')) != NULL ) *q = '\0' ; - if (( include_fp = fopen( include_file_name , "r" )) != NULL ) { foundit = 1 ; goto gotit ; } - - // See if it might be in the directory specified (or whatever dir is). Don't remove spaces from the dir name though. - sprintf( include_file_name , "%s", p ) ; // first name in line from registry file, without the include or usefrom - for ( p2 = include_file_name ; !( *p2 == ' ' || *p2 == '\t' || *p2 == '\n' ) && *p2 != '\0' ; p2++ ) {} - *p2 = '\0' ; // drop tailing white space - sprintf( include_file_name , "%s/%s", dir, p ); // set the dir + file - if ( (q=index(include_file_name,'\n')) != NULL ) *q = '\0' ; - if (( include_fp = fopen( include_file_name , "r" )) != NULL ) { foundit = 1 ; goto gotit ; } - - // Check in the list of include dirs - for ( ifile = 0 ; ifile < nincldirs ; ifile++ ) { - sprintf( include_file_name_tmp , "%s", p ) ; // first name in line from registry file, without the include or usefrom - for ( p2 = include_file_name_tmp ; !( *p2 == ' ' || *p2 == '\t' || *p2 == '\n' ) && *p2 != '\0' ; p2++ ) {} - *p2 = '\0' ; // drop tailing white space - sprintf( include_file_name, "%s/%s", IncludeDirs[ifile] , include_file_name_tmp ) ; // dir specified with -I - if ( (q=index(include_file_name,'\n')) != NULL ) *q = '\0' ; - if (( include_fp = fopen( include_file_name , "r" )) != NULL ) { foundit = 1 ; goto gotit ; } - } - - // Cygwin specific -- assuming spaces in dir are ok. - for ( ifile = 0 ; ifile < nincldirs ; ifile++ ) { - int drive_specified = 0 ; - sprintf( include_file_name_tmp , "%s", p ) ; // first name in line from registry file, without the include or usefrom - for ( p2 = include_file_name_tmp ; !( *p2 == ' ' || *p2 == '\t' || *p2 == '\n' ) && *p2 != '\0' ; p2++ ) {} - *p2 = '\0' ; - sprintf( include_file_name , "%s/%s", IncludeDirs[ifile] , include_file_name_tmp ) ; // dir munged for cigwin - if ( include_file_name[0] == '/' ) { - char tmp[NAMELEN], tmp2[NAMELEN], *dr ; - strcpy( tmp2, include_file_name ) ; - if ( !strncmp( tmp2, "/cygdrive/", 10 )) { - strcpy(tmp,tmp2+11) ; // skip past /cygdrive/c - strcpy(tmp2,tmp) ; - drive_specified = 1 ; - } - for ( dr = "abcdefmy" ; *dr ; dr++ ) { - sprintf(tmp,"%c:%s%s",*dr,(drive_specified)?"":"/cygwin",tmp2) ; - strcpy( include_file_name, tmp ) ; - for ( p2 = include_file_name ; !( *p2 == ' ' || *p2 == '\t' || *p2 == '\n' ) && *p2 != '\0' ; p2++ ) {} - *p2 = '\0' ; - if ( (q=index(include_file_name,'\n')) != NULL ) *q = '\0' ; - if (( include_fp = fopen( include_file_name , "r" )) != NULL ) { foundit = 1 ; goto gotit ; } - } - } - } - -gotit: - if ( foundit ) { - fprintf(stderr,"opening %s %s\n",include_file_name, - (checking_for_usefrom || usefrom_sw)?"in usefrom mode":"" ) ; - parseline[0] = '\0' ; - pre_parse( dir , include_fp , outfile, ( checking_for_usefrom + usefrom_sw ) ) ; - parseline[0] = '\0' ; -// fprintf(stderr,"closing %s %s\n",include_file_name, -// (checking_for_usefrom || usefrom_sw)?"in usefrom mode":"" ) ; - fclose( include_fp ) ; - continue ; - } else { - if ( ! checking_for_usefrom ) { - fprintf(stderr,"Registry warning: cannot open %s . Ignoring.\n", include_file_name ) ; - } - } - } - } - else if ( !strncmp( make_lower_temp(p) , "ifdef", 5 ) ) { - char value[32] ; - p += 5 ; for ( ; ( *p == ' ' || *p == '\t' ) && *p != '\0' ; p++ ) ; - strncpy(value, p, 31 ) ; value[31] = '\0' ; - if ( (p=index(value,'\n')) != NULL ) *p = '\0' ; - if ( (p=index(value,' ')) != NULL ) *p = '\0' ; - if ( (p=index(value,'\t')) != NULL ) *p = '\0' ; - ifdef_stack_ptr++ ; - ifdef_stack[ifdef_stack_ptr] = ( sym_get(value) != NULL && ifdef_stack[ifdef_stack_ptr-1] ) ; - if ( ifdef_stack_ptr >= 100 ) { fprintf(stderr,"Registry fatal: too many nested ifdefs\n") ; exit(1) ; } - continue ; - } - else if ( !strncmp( make_lower_temp(p) , "ifndef", 6 ) ) { - char value[32] ; - p += 6 ; for ( ; ( *p == ' ' || *p == '\t') && *p != '\0' ; p++ ) ; - strncpy(value, p, 31 ) ; value[31] = '\0' ; - if ( (p=index(value,'\n')) != NULL ) *p = '\0' ; - if ( (p=index(value,' ')) != NULL ) *p = '\0' ; - if ( (p=index(value,'\t')) != NULL ) *p = '\0' ; - ifdef_stack_ptr++ ; - ifdef_stack[ifdef_stack_ptr] = ( sym_get(value) == NULL && ifdef_stack[ifdef_stack_ptr-1] ) ; - if ( ifdef_stack_ptr >= 100 ) { fprintf(stderr,"Registry fatal: too many nested ifdefs\n") ; exit(1) ; } - continue ; - } - else if ( !strncmp( make_lower_temp(p) , "endif", 5 ) ) { - ifdef_stack_ptr-- ; - if ( ifdef_stack_ptr < 0 ) { fprintf(stderr,"Registry fatal: unmatched endif\n") ; exit(1) ; } - continue ; - } - else if ( !strncmp( make_lower_temp(p) , "define", 6 ) ) { - char value[32] ; - p += 6 ; for ( ; ( *p == ' ' || *p == '\t') && *p != '\0' ; p++ ) ; - strncpy(value, p, 31 ) ; value[31] = '\0' ; - if ( (p=index(value,'\n')) != NULL ) *p = '\0' ; - if ( (p=index(value,' ')) != NULL ) *p = '\0' ; - if ( (p=index(value,'\t')) != NULL ) *p = '\0' ; - sym_add( value ) ; - continue ; - } - if ( ifdef_stack_ptr >= 0 && ! ifdef_stack[ifdef_stack_ptr] ) continue ; -/*** end of preprocessing directives ****/ -//fprintf(stderr,"parseline |%s|\n",parseline) ; -//fprintf(stderr,"inln |%s|\n",inln) ; - - strcat( parseline , inln ) ; - - /* allow \ to continue the end of a line */ - if (( p = index( parseline, '\\' )) != NULL ) - { - if ( *(p+1) == '\n' || *(p+1) == '\0' ) - { - *p = '\0' ; - continue ; /* go get another line */ - } - } -// make_lower( parseline ) ; - - if (( p = index( parseline , '\n' )) != NULL ) *p = '\0' ; /* discard newlines */ - - /* check line and zap any # characters that are in double quotes */ - - for ( p = parseline, inquote = 0 ; *p ; p++ ) { - if ( *p == '"' && inquote ) inquote = 0 ; - else if ( *p == '"' && !inquote ) inquote = 1 ; - else if ( *p == '#' && inquote ) *p = ' ' ; - else if ( *p == '#' && !inquote ) { *p = '\0' ; break ; } - } - if ( inquote ) { retval=1 ; fprintf(stderr,"Registry error: unbalanced quotes in line:\n%s\n",parseline) ;} - - for ( i = 0 ; i < MAXTOKENS ; i++ ) tokens[i] = NULL ; - i = 0 ; - - // get parsline_save, the value written to the output file... - //fprintf(stderr,"parseline_save |%s|\n",parseline_save) ; - //strcpy(parseline_save, parseline); - for (p = parseline; (*p == ' ' || *p == '\t') && *p != '\0'; p++); - strcpy(parseline_save, p); // get rid of leading spaces - - if (!strncmp(parseline_save, "typedef", 7)) - { - char tmp[PARSELINE_SIZE], *x; - strcpy(tmp, parseline_save); - x = strpbrk(tmp, " \t"); // find the first space or tab - if (usefrom_sw && x) { - sprintf(parseline_save, "usefrom%i %s", usefrom_sw, x); - } - } - - // parse tokens from parseline - if ((tokens[i] = my_strtok(parseline)) != NULL ) i++ ; - while (( tokens[i] = my_strtok(NULL) ) != NULL && i < MAXTOKENS ) i++ ; - if ( i <= 0 ) continue ; - - for ( i = 0 ; i < MAXTOKENS ; i++ ) - { - if ( tokens[i] == NULL ) tokens[i] = "-" ; - } - -/* remove quotes from quoted entries */ - for ( i = 0 ; i < MAXTOKENS ; i++ ) - { - char * pp ; - if ( tokens[i][0] == '"' ) tokens[i]++ ; - if ((pp=rindex( tokens[i], '"' )) != NULL ) *pp = '\0' ; - } - - - -//normal: - /* otherwise output the line as is */ - fprintf(outfile,"%s\n",parseline_save) ; - parseline[0] = '\0' ; /* reset parseline */ - parseline_save[0] = '\0' ; /* reset parseline_save */ - } - return(retval) ; -} - -int -reg_parse( FILE * infile ) -{ - /* Had to increase size for SOA from 4096 to 7000, Manish Shrivastava 2010 */ - char inln[INLN_SIZE], parseline[PARSELINE_SIZE] ; - char *p ; - char *tokens[MAXTOKENS],*ditto[MAXTOKENS] ; - int i ; - int defining_state_field, defining_rconfig_field, defining_i1_field ; - - parseline[0] = '\0' ; - - max_time_level = 1 ; - - for ( i = 0 ; i < MAXTOKENS ; i++ ) { ditto[i] = (char *)malloc(NAMELEN) ; strcpy(ditto[i],"-") ; } - -/* main parse loop over registry lines */ - while ( fgets ( inln , INLN_SIZE , infile ) != NULL ) - { - strcat( parseline , inln ) ; - /* allow \ to continue the end of a line */ - if (( p = index( parseline, '\\' )) != NULL ) - { - if ( *(p+1) == '\n' || *(p+1) == '\0' ) - { - *p = '\0' ; - continue ; /* go get another line */ - } - } - - //make_lower( parseline ) ; - if (( p = index( parseline , '#' )) != NULL ) *p = '\0' ; /* discard comments (dont worry about quotes for now) */ - if (( p = index( parseline , '\n' )) != NULL ) *p = '\0' ; /* discard newlines */ - if (( p = index( parseline , '\r' )) != NULL ) *p = '\0' ; /* discard carriage returns (happens on Windows)*/ - for ( i = 0 ; i < MAXTOKENS ; i++ ) tokens[i] = NULL ; - i = 0 ; - - if ((tokens[i] = my_strtok(parseline)) != NULL ) i++ ; - while (( tokens[i] = my_strtok(NULL) ) != NULL && i < MAXTOKENS ) i++ ; - if ( i <= 0 ) continue ; - - - for ( i = 0 ; i < MAXTOKENS ; i++ ) - { - if ( tokens[i] == NULL ) tokens[i] = "-" ; - if ( strcmp(tokens[i],"^") ) { // that is, if *not* ^ - strcpy(ditto[i],tokens[i]) ; - } else { // if is ^ - tokens[i] = ditto[i] ; - } - } - -/* remove quotes from quoted entries */ - for ( i = 0 ; i < MAXTOKENS ; i++ ) - { - char * pp ; - if ( tokens[i][0] == '"' ) tokens[i]++ ; - if ((pp=rindex( tokens[i], '"' )) != NULL ) *pp = '\0' ; - } - - defining_state_field = 0 ; - defining_rconfig_field = 0 ; - defining_i1_field = 0 ; - -/* typedef, usefrom, and param entries */ -// || !strcmp(tokens[TABLE], "usefrom") - if ( !strcmp( tokens[ TABLE ] , "typedef" ) - || !strncmp(tokens[TABLE], "usefrom", 7) - || !strcmp( tokens[ TABLE ] , "param" ) ) - { - node_t * param_struct ; - node_t * field_struct ; - node_t * type_struct ; - node_t * modname_struct ; - char tmpstr[NAMELEN], ddtname[NAMELEN] ; - -// FAST registry, construct a list of module nodes - strcpy(tmpstr, make_lower_temp(tokens[ FIELD_MODNAME ])) ; - if ( (p = index(tmpstr,'/')) != NULL ) *p = '\0' ; - modname_struct = get_modname_entry( tmpstr ) ; - if ( modname_struct == NULL ) - { - char *p ; - modname_struct = new_node( MODNAME ) ; - strcpy( modname_struct->name, tokens[FIELD_MODNAME] ) ; - // if a shortname is indicated after a slash, record that, otherwise use full name for both - if ( (p = index(modname_struct->name,'/')) != NULL ) { - *p = '\0' ; - strcpy( modname_struct->nickname, p+1 ) ; - } else { - strcpy( modname_struct->nickname, modname_struct->name ) ; - } - - modname_struct->module_ddt_list = NULL ; - modname_struct->next = NULL ; - add_node_to_end( modname_struct , &ModNames ) ; - } - if (!strcmp(tokens[TABLE], "usefrom")) - { - modname_struct->usefrom = 1; - } else if(!strncmp(tokens[TABLE], "usefrom", 7)) - { - tokens[TABLE] += 7; - if (!strcmp(tokens[TABLE], "1")) - { - modname_struct->usefrom = 1; - } - else - { - modname_struct->usefrom = 2; - } - } - - if ( !strcmp( tokens[ TABLE ] , "param" ) ) { -// FAST registry, construct list of params specified for the Module - param_struct = new_node( PARAM ) ; - sprintf(param_struct->name,"%s",tokens[ FIELD_SYM ]) ; // name of parameter - if ( set_state_type( tokens[FIELD_TYPE], param_struct, Type, NULL ) ) // Only search type list, not ddts for module - { fprintf(stderr,"Registry warning: type %s used before defined for %s\n",tokens[FIELD_TYPE],tokens[FIELD_SYM] ) ; } - if ( set_state_dims( tokens[FIELD_DIMS], param_struct ) ) - { fprintf(stderr,"Registry warning: some problem with dimstring %s for %s\n", tokens[FIELD_DIMS],tokens[FIELD_SYM] ) ; } - param_struct->inival[0] = '\0' ; - if ( strcmp( tokens[FIELD_INIVAL], "-" ) ) /* that is, if not equal "-" */ - { strcpy( param_struct->inival , tokens[FIELD_INIVAL] ) ; } - strcpy(param_struct->descrip,"-") ; - if ( strcmp( tokens[FIELD_DESCRIP], "-" ) ) /* that is, if not equal "-" */ - { strcpy( param_struct->descrip , tokens[FIELD_DESCRIP] ) ; } - strcpy(param_struct->units,"-") ; - if ( strcmp( tokens[FIELD_UNITS], "-" ) ) /* that is, if not equal "-" */ - { strcpy( param_struct->units , tokens[FIELD_UNITS] ) ; } - - add_node_to_end( param_struct , &(modname_struct->params) ) ; - - } else { // not param - -// FAST registry, construct list of derived data types specified for the Module -// Only the FAST interface defined types should have the Module's nickname prepended - sprintf(ddtname,"%s",tokens[ FIELD_OF ]) ; - modname_struct->is_interface_type = 0 ; - if ( strcmp(modname_struct->nickname,"") ) { - if ( is_a_fast_interface_type(tokens[FIELD_OF] ) ) { - sprintf(ddtname,"%s_%s",modname_struct->nickname,tokens[ FIELD_OF ]) ; - modname_struct->is_interface_type = 1 ; - } - } - sprintf(tmpstr,"%s",make_lower_temp(ddtname)) ; - type_struct = get_entry( tmpstr, modname_struct->module_ddt_list ) ; - if ( type_struct == NULL && modname_struct->usefrom) - { - type_struct = get_entry( tmpstr, Type ) ; - } - - if ( type_struct == NULL ) - { - type_struct = new_node( TYPE ) ; - strcpy( type_struct->name, tmpstr ) ; - strcpy(type_struct->mapsto,ddtname) ; - type_struct->type_type = DERIVED ; - type_struct->next = NULL ; - type_struct->usefrom = modname_struct->usefrom ; - type_struct->module = modname_struct ; - add_node_to_end( type_struct,(type_struct->usefrom)? &Type : &(modname_struct->module_ddt_list ) ) ; - } - -// FAST registry, construct the list of fields in the derived types in the Module - field_struct = new_node( FIELD ) ; - strcpy( field_struct->name, tokens[FIELD_SYM] ) ; - if ( set_state_type( tokens[FIELD_TYPE], field_struct, Type, modname_struct->module_ddt_list ) ) - { fprintf(stderr,"Registry warning: type %s used before defined for %s\n",tokens[FIELD_TYPE],tokens[FIELD_SYM] ) ; } - if ( set_state_dims( tokens[FIELD_DIMS], field_struct ) ) - { fprintf(stderr,"Registry warning: some problem with dimstring %s for %s\n", tokens[FIELD_DIMS],tokens[FIELD_SYM] ) ; } - if ( set_ctrl( tokens[FIELD_CTRL], field_struct ) ) - { fprintf(stderr,"Registry warning: some problem with ctrl %s for %s\n", tokens[FIELD_CTRL],tokens[FIELD_SYM] ) ; } - - field_struct->inival[0] = '\0' ; - if ( strcmp( tokens[FIELD_INIVAL], "-" ) ) /* that is, if not equal "-" */ - { strcpy( field_struct->inival , tokens[FIELD_INIVAL] ) ; } - strcpy(field_struct->descrip,"-") ; - if ( strcmp( tokens[FIELD_DESCRIP], "-" ) ) /* that is, if not equal "-" */ - { strcpy( field_struct->descrip , tokens[FIELD_DESCRIP] ) ; } - strcpy(field_struct->units,"-") ; - if ( strcmp( tokens[FIELD_UNITS], "-" ) ) /* that is, if not equal "-" */ - { strcpy( field_struct->units , tokens[FIELD_UNITS] ) ; } -#ifdef OVERSTRICT - if ( field_struct->type != NULL ) - if ( field_struct->type->type_type == DERIVED && field_struct->ndims > 0 ) - { fprintf(stderr,"Registry warning: type item %s of type %s can not be multi-dimensional ", - tokens[FIELD_SYM], tokens[FIELD_TYPE] ) ; } -#endif - field_struct->usefrom = type_struct->usefrom ; - /* Error Checking for Fortran Pointers used outside of FAST Interfaces: InitInputType, InitOutputType, Parameter */ - /* Note: Skip this check if the -ccode option is being used */ - if (field_struct->ndims > 0) { - if (!sw_ccode && is_pointer(field_struct)) { - if (modname_struct->is_interface_type) { - char nonick[NAMELEN]; - sprintf(tmpstr, "%s", make_lower_temp(ddtname)); - remove_nickname(modname_struct->nickname, tmpstr, nonick); - if (!strcmp(nonick, "continuousstatetype")) { - fprintf(stderr, "REGISTRY ERROR: Fortran Pointer Arrays cannot be used in ContinuousStateType data\n"); - exit(9); - } - if (!strcmp(nonick, "discretestatetype")) { - fprintf(stderr, "REGISTRY ERROR: Fortran Pointer Arrays cannot be used in DiscreteStateType data\n"); - exit(9); - } - if (!strcmp(nonick, "constraintstatetype")) { - fprintf(stderr, "REGISTRY ERROR: Fortran Pointer Arrays cannot be used in ConstraintStateType data\n"); - exit(9); - } - if (!strcmp(nonick, "otherstatetype")) { - fprintf(stderr, "REGISTRY ERROR: Fortran Pointer Arrays cannot be used in OtherStateType data\n"); - exit(9); - } - if (!strcmp(nonick, "miscvartype")) { - fprintf(stderr, "REGISTRY ERROR: Fortran Pointer Arrays cannot be used in MiscVarType data\n"); - exit(9); - } - if (!strcmp(nonick, "inputtype")) { - fprintf(stderr, "REGISTRY ERROR: Fortran Pointer Arrays cannot be used in InputType data\n"); - exit(9); - } - if (!strcmp(nonick, "outputtype")) { - fprintf(stderr, "REGISTRY ERROR: Fortran Pointer Arrays cannot be used in OutputType data\n"); - exit(9); - } - } - } - } - add_node_to_end( field_struct , &(type_struct->fields) ) ; - } // not param - - } - -/* dimspec entry */ - else if ( !strcmp( tokens[ TABLE ] , "dimspec" ) ) - { - node_t * dim_struct ; - dim_struct = new_node( DIM ) ; - if ( get_dim_entry ( tokens[DIM_NAME], 0 ) != NULL ) - { fprintf(stderr,"Registry warning: dimspec (%s) already defined\n",tokens[DIM_NAME] ) ; } - strcpy(dim_struct->dim_name,tokens[DIM_NAME]) ; - if ( set_dim_len( tokens[DIM_SPEC], dim_struct ) ) - { fprintf(stderr,"Registry warning: problem with dimspec (%s)\n",tokens[DIM_SPEC] ) ; } - - add_node_to_end( dim_struct , &Dim ) ; - } - - parseline[0] = '\0' ; /* reset parseline */ - } - -/* Domain is a type node with fields that are not part of any type. WRF "state" entries - were these. They were simply fields of the data type for a domain (as opposed to - fields within derived data types that were fields in a domain). The FAST registry - does not have the concept of a Domain. Leave the following assignment here but - put a test around it so we do not segfault if there aren't any "state" entries. */ - if ( get_type_entry( "domain" ) ) { - Domain = *(get_type_entry( "domain" )) ; - } - - return(0) ; - -} - -node_t * -get_dim_entry( char *s, int sw ) // sw = 1 is used when checking an inline dimspec -{ - node_t * p ; - for ( p = Dim ; p != NULL ; p = p->next ) - { - if ( !strcmp(p->dim_name, s ) ) { - return( p ) ; - } - } - /* not found, check if dimension is specified in line */ - if ( 1 && sw ) { - node_t * dim_struct ; - dim_struct = new_node( DIM ) ; - strcpy(dim_struct->dim_name,s) ; -// strncpy(dim_struct->dim_name,s,1) ; - if ( set_dim_len( s, dim_struct ) ) - { - fprintf(stderr,"Registry warning: get_dim_entry: problem with dimspec (%s)\n",s ) ; - } - else - { - add_node_to_end( dim_struct , &Dim ) ; - return( dim_struct ) ; - } - } - return(NULL) ; -} - -int -set_state_type( char * typename, node_t * state_entry, node_t * typelist, node_t * ddtlist ) -{ - node_t *p ; - int retval ; - - if ( typename == NULL ) return(1) ; - retval = 0 ; - if ( ( state_entry->type = get_entry( make_lower_temp(typename), ddtlist )) == NULL ) { - if ( ( state_entry->type = get_entry( make_lower_temp(typename), typelist )) == NULL ) { - if ( !strncmp(make_lower_temp(typename),"character",9) ) - { - p = new_node( TYPE ) ; - strcpy( p->name, make_lower_temp(typename) ) ; - strcpy( p->mapsto, typename ) ; - add_node_to_end( p , &(state_entry->type) ) ; - } else { - retval = 1 ; - } - } - } - return(retval) ; -} - -int -set_dim_len ( char * dimspec , node_t * dim_entry ) -{ - dim_entry->deferred = 0 ; - dim_entry->is_pointer = 0; - if (!strcmp( dimspec , "standard_domain" )) - { dim_entry->len_defined_how = DOMAIN_STANDARD ; } - else if (!strncmp( dimspec, "constant=" , 9 ) || isNum(dimspec[0]) || dimspec[0] == ':' || dimspec[0] == '*' || dimspec[0] == '(' ) - { - char *p, *colon, *paren ; - p = (isNum(dimspec[0])||dimspec[0]==':'||dimspec[0]=='*'||dimspec[0]=='(')?dimspec:&(dimspec[9]) ; - /* check for colon */ - if (( colon = index(p,':')) != NULL ) - { - *colon = '\0' ; - if (( paren = index(p,'(')) !=NULL ) - { - dim_entry->coord_start = atoi(paren+1) ; - } - else if ( isNum(*p) ) { - dim_entry->coord_start = atoi(p) ; - } - else - { - dim_entry->deferred = 1 ; - } - dim_entry->coord_end = atoi(colon+1) ; - } - else if ((colon = index(p, '*')) != NULL) - { - *colon = '\0'; - dim_entry->deferred = 1; - dim_entry->coord_end = atoi(colon + 1); - dim_entry->is_pointer = 1; - } - else - { - dim_entry->coord_start = 1 ; - dim_entry->coord_end = atoi(p) ; - } - dim_entry->len_defined_how = CONSTANT ; - } - else if (!strncmp( dimspec, "namelist=", 9 )) - { - char *p, *colon ; - - p = &(dimspec[9]) ; - /* check for colon */ - if (( colon = index(p,':')) != NULL ) - { - *colon = '\0' ; - strcpy( dim_entry->assoc_nl_var_s, p ) ; - strcpy( dim_entry->assoc_nl_var_e, colon+1 ) ; - } - else - { - strcpy( dim_entry->assoc_nl_var_s, "1" ) ; - strcpy( dim_entry->assoc_nl_var_e, p ) ; - } - dim_entry->len_defined_how = NAMELIST ; - } - else /* if (param_dim != NULL) */ { - dim_entry->coord_start = 1; - dim_entry->len_defined_how = CONSTANT; - strcpy(dim_entry->dim_param_name, dimspec); - dim_entry->dim_param = 1; - } -/* else - { - return(1) ; - } -*/ - return(0) ; -} - -int -set_ctrl( char *ctrl , node_t * field_struct ) -// process CTRL keys -- only '2pi' (interpolation of values with 2pi period). Default is no special interpolation. -{ - char tmp[NAMELEN] ; - char *p ; - strcpy(tmp,ctrl) ; - if (( p = index(tmp,'=') ) != NULL ) { *p = '\0' ; } - if (!strcmp(make_lower_temp(tmp), "2pi")) { - field_struct->gen_periodic = PERIOD_2PI; - } - else { - field_struct->gen_periodic = PERIOD_NONE; - } - - return(0) ; -} - - -/* integrity checking of dimension list */ -int -check_dimspecs() -{ - return(0) ; -} - -int -init_parser() -{ - return(0) ; -} - -int -is_a_fast_interface_type( char *str ) -{ - int retval ; - - retval = ( - !strcmp(make_lower_temp(str), "initinputtype") || - !strcmp(make_lower_temp(str), "initoutputtype") || - !strcmp(make_lower_temp(str), "inputtype") || - !strcmp(make_lower_temp(str), "outputtype") || - !strcmp(make_lower_temp(str), "continuousstatetype") || - !strcmp(make_lower_temp(str), "discretestatetype") || - !strcmp(make_lower_temp(str), "constraintstatetype") || - !strcmp(make_lower_temp(str), "otherstatetype") || - !strcmp(make_lower_temp(str), "parametertype") || - !strcmp(make_lower_temp(str), "miscvartype") || - !strcmp(make_lower_temp(str), "partialoutputpinputtype") || - !strcmp(make_lower_temp(str), "partialcontstatepinputtype") || - !strcmp(make_lower_temp(str), "partialdiscstatepinputtype") || - !strcmp(make_lower_temp(str), "partialconstrstatepinputtype") || - 0 ) ; - - return(retval) ; -} - -int -must_have_real_or_double( char *str ) -{ - int retval ; - - retval = ( - !strcmp(make_lower_temp(str), "inputtype") || - !strcmp(make_lower_temp(str), "outputtype") || - !strcmp(make_lower_temp(str), "continuousstatetype") || - !strcmp(make_lower_temp(str), "discretestatetype") || - !strcmp(make_lower_temp(str), "constraintstatetype") || - !strcmp(make_lower_temp(str), "partialoutputpinputtype") || - !strcmp(make_lower_temp(str), "partialcontstatepinputtype") || - !strcmp(make_lower_temp(str), "partialdiscstatepinputtype") || - !strcmp(make_lower_temp(str), "partialconstrstatepinputtype") || - 0 ) ; - - return(retval) ; -} - -char * -fast_interface_type_shortname( char *str ) -{ - char * retval, *str2; - str2 = make_lower_temp(str); - - if ( !strcmp(str2, "initinputtype") ) { - retval = "InitInput" ; - } else if ( !strcmp(str2, "initoutputtype") ) { - retval = "InitOutput" ; - } else if ( !strcmp(str2, "inputtype") ) { - retval = "Input" ; - } else if ( !strcmp(str2, "outputtype") ) { - retval = "Output" ; - } else if ( !strcmp(str2, "continuousstatetype") ) { - retval = "ContState" ; - } else if ( !strcmp(str2, "discretestatetype") ) { - retval = "DiscState" ; - } else if ( !strcmp(str2, "constraintstatetype") ) { - retval = "ConstrState" ; - } else if ( !strcmp(str2, "otherstatetype") ) { - retval = "OtherState" ; - } else if ( !strcmp(str2, "miscvartype") ) { - retval = "Misc"; - } else if ( !strcmp(str2, "parametertype") ) { - retval = "Param" ; - } else if ( !strcmp(str2, "partialoutputpinputtype") ) { - retval = "dYdu" ; - } else if ( !strcmp(str2, "partialcontstatepinputtype") ) { - retval = "dXdu" ; - } else if ( !strcmp(str2, "partialdiscstatepinputtype") ) { - retval = "dXddu" ; - } else if ( !strcmp(str2, "partialconstrstatepinputtype") ) { - retval = "dZdu" ; - } - else{ - retval = str; - } - - - return(retval) ; -} - -char * -std_case( char *str ) // returns the name in CamelBack case or just the name itself -{ - if ( !strcmp(make_lower_temp(str), "initinputtype")) {return("InitInputType");} - else if ( !strcmp(make_lower_temp(str), "initoutputtype")) {return("InitOutputType");} - else if ( !strcmp(make_lower_temp(str), "inputtype")) {return("InputType");} - else if ( !strcmp(make_lower_temp(str), "outputtype")) {return("OutputType");} - else if ( !strcmp(make_lower_temp(str), "continuousstatetype")) {return("ContinuousStateType");} - else if ( !strcmp(make_lower_temp(str), "discretestatetype")) {return("DiscreteStateType");} - else if ( !strcmp(make_lower_temp(str), "constraintstatetype")) {return("ConstraintStateType");} - else if ( !strcmp(make_lower_temp(str), "otherstatetype")) {return("OtherStateType");} - else if ( !strcmp(make_lower_temp(str), "miscvartype")) {return("MiscVarType"); } - else if ( !strcmp(make_lower_temp(str), "parametertype")) {return("ParameterType"); } - else if ( !strcmp(make_lower_temp(str), "partialoutputpinputtype")) {return("PartialOutputPInputType");} - else if ( !strcmp(make_lower_temp(str), "partialcontstatepinputtype")) {return("PartialConstStatePInputType");} - else if ( !strcmp(make_lower_temp(str), "partialdiscstatepinputtype")) {return("PartialDiscStatePInputType");} - else if ( !strcmp(make_lower_temp(str), "partialconstrstatepinputtype")) {return("PartialConstrStatePInputType");} - else {return(str);} - // shouldn't happen - return("") ; -} - diff --git a/modules/openfast-registry/src/registry.c b/modules/openfast-registry/src/registry.c deleted file mode 100644 index 2fe9dc566e..0000000000 --- a/modules/openfast-registry/src/registry.c +++ /dev/null @@ -1,311 +0,0 @@ -#include -#include -#include -#ifdef _WIN32 -# include -# define rindex(X,Y) strrchr(X,Y) -# define index(X,Y) strchr(X,Y) -# include -# define getpid _getpid -#else -# include -# include -# include -# include -#endif - -#define DEFINE_GLOBALS -#include "protos.h" -#include "registry.h" -#include "data.h" -#include "sym.h" - -void output_template( char * sw_modname_subst, char * sw_modnickname_subst, int force, int sw ); -int matches( char * str , char * match ); - -int -main( int argc, char *argv[], char *env[] ) -{ - char fname_in[NAMELEN], dir[NAMELEN], fname_tmp[NAMELEN], command[NAMELEN] ; - FILE * fp_in, *fp_tmp ; - char * thisprog ; - char * thisprog_ver; - int mypid ; - int wrote_template ; - int sw_keep = 0 ; -#ifndef _WIN32 - struct rlimit rlim ; -#endif - - mypid = (int) getpid() ; - strcpy( thiscom, argv[0] ) ; - argv++ ; - - sw_output_template_force = 0 ; - sw_norealloc_lsh = 1 ; - sw_ccode = 0 ; - sw_noextrap = 0 ; - sw_shownodes = 0 ; - strcpy( fname_in , "" ) ; - -#ifndef _WIN32 - rlim.rlim_cur = RLIM_INFINITY ; - rlim.rlim_max = RLIM_INFINITY ; - setrlimit ( RLIMIT_STACK , &rlim ) ; -#endif - - thisprog_ver = "FAST Registry"; - - fprintf(stderr,"\n") ; - fprintf(stderr,"----- %s --------------\n", thisprog_ver) ; - fprintf(stderr,"----------------------------------------------------------\n") ; - - sym_forget() ; - //thisprog = *argv ; - // strcpy(thisprog, thiscom); - thisprog = "registry.exe"; - strcpy(fname_in, ""); - strcpy(OutDir, "."); // if no OutDir is listed, use current directory - wrote_template = 0; - - - while (*argv) { - - if (!strncmp(*argv,"-D",2)) { - char * p ; - p = *argv ; - sym_add(p+2) ; - } else if (!strncmp(*argv,"/D=",3)) { - char * p ; - p = *argv ; - sym_add(p+3) ; - } else if (!strcmp(*argv,"-force") || !strcmp(*argv,"/force") ) { - sw_output_template_force = 1 ; - } else if (!strcmp(*argv,"-O") || !strcmp(*argv,"/O") ) { - argv++ ; if ( *argv ) { strcpy( OutDir, *argv ) ; } - } else if (!strcmp(*argv,"-I") || !strcmp(*argv,"/I") ) { - argv++ ; if ( *argv ) { if( nincldirs < MAXINCLDIRS ) { strcpy( IncludeDirs[nincldirs++], *argv ) ; } } - } else if (!strcmp(*argv, "-ccode") || !strcmp(*argv, "/ccode")) { - sw_ccode = 1 ; - } else if (!strcmp(*argv, "-noextrap") || !strcmp(*argv, "/noextrap")) { - sw_noextrap = 1; - } else if (!strncmp(*argv, "-shownodes", 4) || !strncmp(*argv, "/shownodes", 4)) { - sw_shownodes = 1 ; - } else if (!strcmp(*argv,"-template") || !strcmp(*argv,"-registry") || - !strcmp(*argv,"/template") || !strcmp(*argv,"/registry") ) { - char * arg ; - arg = *argv ; - argv++ ; if ( *argv ) { strcpy( sw_modname_subst, *argv ) ; } else { goto usage ; } - argv++ ; if ( *argv ) { strcpy( sw_modnickname_subst, *argv ) ; } else { goto usage ; } - if (!strcmp(arg+1,"template")) output_template(sw_modname_subst,sw_modnickname_subst,sw_output_template_force,0) ; - if (!strcmp(arg+1,"registry")) output_template(sw_modname_subst,sw_modnickname_subst,sw_output_template_force,1) ; - wrote_template = 1 ; - } else if (!strcmp(*argv,"-h") || !strcmp(*argv,"/h")) { -usage: -// fprintf(stderr,"Usage: %s [options] registryfile -or- \n",thisprog) ; - fprintf(stderr, "Usage: %s registryfile [options] -or- \n",thiscom) ; - fprintf(stderr, " [-force] [-template|-registry] ModuleName ModName \n") ; - fprintf(stderr, "Options:\n"); - fprintf(stderr, " -h this summary\n"); - fprintf(stderr, " -I look for usefrom files in directory \"dir\"\n"); - fprintf(stderr, " -O generate types files in directory \"dir\"\n"); - fprintf(stderr, " -noextrap do not generate ModName_Input_ExtrapInterp or ModName_Output_ExtrapInterp routines\n"); - fprintf(stderr, " -D define symbol for conditional evaluation inside registry file\n"); - fprintf(stderr, " -ccode generate additional code for interfacing with C/C++\n") ; - fprintf(stderr, " -keep do not delete temporary files from registry program\n") ; - fprintf(stderr, " -shownodes output a listing of the nodes in registry's AST\n") ; - fprintf(stderr, " === alternate usage for generating templates ===\n") ; - fprintf(stderr, " -template ModuleName ModName\n") ; - fprintf(stderr, " Generate a template Module file none exists\n") ; - fprintf(stderr, " -registry ModuleName ModName\n") ; - fprintf(stderr, " Generate a template registry file if none exists\n") ; - fprintf(stderr, " -force Force generating of template or registry file\n") ; - fprintf(stderr, " (the / character can be used in place of - when specifying options)\n") ; - exit(1) ; - } else if (!strcmp(*argv,"-keep") || !strcmp(*argv,"/keep") ) { - sw_keep = 1 ; - } - else { /* consider it an input file */ - strcpy( fname_in , *argv ) ; - } - argv++ ; - } - if ( wrote_template ) exit(0) ; - - if ( !strcmp(fname_in,"") ) goto usage ; - -#ifdef FUTURE - gen_io_boilerplate() ; /* 20091213 jm. Generate the io_boilerplate_temporary.inc file */ -#endif - - fprintf(stderr,"input file: %s\n",fname_in); - - init_parser() ; - init_type_table() ; - init_dim_table() ; - init_modname_table() ; - - if ( !strcmp(fname_in,"") ) fp_in = stdin ; - else - if (( fp_in = fopen( fname_in , "r" )) == NULL ) - { - fprintf(stderr,"Registry program cannot open %s for reading. Ending.\n", fname_in ) ; - exit(2) ; - } - - sprintf( fname_tmp , "Registry_tmp.%d",mypid) ; - if (( fp_tmp = fopen( fname_tmp , "w" )) == NULL ) - { - fprintf(stderr,"Registry program cannot open temporary %s for writing. Ending.\n", fname_tmp ) ; - exit(2) ; - } - - { char *e ; - strcpy( dir , fname_in ) ; - if ( ( e = rindex ( dir , '/' ) ) != NULL ) { *e = '\0' ; } else { strcpy( dir, "." ) ; } - } - if ( pre_parse( dir, fp_in, fp_tmp, 0 ) ) { - fprintf(stderr,"Problem with Registry File %s\n", fname_in ) ; - goto cleanup ; - } - sym_forget() ; - - fclose(fp_in) ; - fclose(fp_tmp) ; - - if (( fp_tmp = fopen( fname_tmp , "r" )) == NULL ) - { - fprintf(stderr,"Registry program cannot open %s for reading. Ending.\n", fname_tmp ) ; - goto cleanup ; - } - - reg_parse(fp_tmp) ; - - fclose(fp_tmp) ; - - check_dimspecs() ; - - if (sw_shownodes) { - fprintf(stderr,"--- ModNames ---\n") ; - show_nodelist(ModNames) ; - fprintf(stderr,"--- Done ---\n") ; - } - - gen_module_files( OutDir, thisprog_ver); - -cleanup: - if ( ! sw_keep ) { -#ifdef _WIN32 - sprintf(command,"del /F /Q %s\n",fname_tmp ); -#else - sprintf(command,"/bin/rm -f %s\n",fname_tmp ); -#endif - system( command ) ; - } - - exit( 0 ) ; - -} -#include "Template_data.c" -#include "Template_registry.c" - -void -output_template( char * sw_modname_subst, char * sw_modnickname_subst, int force, int sw ) // sw = 0, template; 1 = registry -{ - char ** p ; - FILE *fp ; - char fname[NAMELEN] ; - char tmp1[2096], tmp2[2096], tmp3[2096] ; - if ( sw == 0 ) { sprintf(fname,"%s.f90",sw_modname_subst) ; } - else { sprintf(fname,"%s_Registry.txt",sw_modname_subst) ; } - - if ( ! force ) { // check if file exists by trying to open file for reading. If the read is successful, exit program: - if ( (fp = fopen( fname,"r" )) != NULL ) { - fprintf(stderr,"Registry exiting. Attempt to overwrite file (%s) . Move out of the way or specify -force before -template option. \n", fname) ; - exit(1) ; - } - } - - if ( (fp = fopen( fname,"w" )) == NULL ) { - fprintf(stderr,"Registry exiting. Failure opening %s.\n", fname ) ; - exit(1) ; - } - if ( sw == 0 ) { - for ( p = template_data ; *p ; p++ ) { - strcpy(tmp1,*p) ; - substitute(tmp1,"ModuleName",sw_modname_subst,tmp2) ; - substitute(tmp2,"ModName",sw_modnickname_subst,tmp3) ; - fprintf(fp,"%s\n",tmp3) ; - } - } else { - for ( p = template_registry ; *p ; p++ ) { - strcpy(tmp1,*p) ; - substitute(tmp1,"ModuleName",sw_modname_subst,tmp2) ; - substitute(tmp2,"ModName",sw_modnickname_subst,tmp3) ; - fprintf(fp,"%s\n",tmp3) ; - } - } - fclose(fp) ; -} - - - -// would use regex for this but it does not seem to be uniformly or universally supported - -void -substitute( char * str , char * match , char * replace, char * result ) -{ - char * p, *q ; - char allup[NAMELEN], alllo[NAMELEN] ; - size_t n, m ; - int nmatch = 0 ; - - n = strlen( replace ) ; - m = strlen( match ) ; - strcpy(allup,replace) ; make_upper_case(allup) ; - strcpy(alllo,replace) ; make_lower_case(alllo) ; -// watch for #defines, in which case first sub should be all upper, next all lower - if ( str[0] == '#' ) { - for ( p = str ; *p ; p++ ) { - if ( matches( p, "define" ) ) nmatch = 2 ; - } - } - - for ( p = str , q = result ; *p ; ) - { - if ( matches( p, match ) ) - { - if ( nmatch == 2 ) { - strncpy( q, replace, n ) ; - nmatch-- ; - } else if ( nmatch == 1 ) { - strncpy( q, alllo, n ) ; - nmatch-- ; - } else { - strncpy( q, replace, n ) ; - } - q += n ; - p += m ; - } else { - *q = *p ; - p++ ; - q++ ; - } - } - *q = '\0' ; - strcpy( str, result ) ; -} - -int -matches( char * str , char * match ) // both must be null terminated -{ - char * p, * q ; - int n ; - - for ( n = 0, p = str, q = match ; (*p && *q) ; p++, q++, n++ ) - { - if ( *p != *q ) return(0) ; - } - if ( n != strlen(match) ) return(0) ; - return(1) ; -} diff --git a/modules/openfast-registry/src/registry.cpp b/modules/openfast-registry/src/registry.cpp new file mode 100644 index 0000000000..b0ad7ad660 --- /dev/null +++ b/modules/openfast-registry/src/registry.cpp @@ -0,0 +1,36 @@ +#include "registry.hpp" + +void Registry::gen_module_files(std::string const &out_dir) +{ + // Find root module + std::shared_ptr mod; + for (auto &it : this->modules) + { + if (it.second->is_root) + { + mod = it.second; + break; + } + } + + // If module not found, return error + if (mod == nullptr) + { + std::cerr << "unable to find root module" << std::endl; + exit(EXIT_FAILURE); + } + + // Generate fortran module + this->gen_fortran_module(*mod, out_dir); + + // Generate C code + if (this->gen_c_code) + this->gen_c_module(*mod, out_dir); +} + +std::string tolower(std::string s) +{ + for (auto &c : s) + c = std::tolower(c); + return s; +} \ No newline at end of file diff --git a/modules/openfast-registry/src/registry.h b/modules/openfast-registry/src/registry.h deleted file mode 100644 index 524bbe7e1a..0000000000 --- a/modules/openfast-registry/src/registry.h +++ /dev/null @@ -1,63 +0,0 @@ -#ifndef REGISTRY_H -#define NAMELEN 512 -#define NAMELEN_LONG 12500 /*changed from 8192 to 12500 by PNNL on 12/22/2010*/ -#define MAXDIMS 21 -#define MAX_DYNCORES 50 /* ha ha, just kidding */ -/* #define MAX_ARGLINE 175 WRF uses 128 by default, but the nested chem version hit the continuation line limit for efc so it had to be increased, wig 14-Oct-2004 */ -#define MAX_ARGLINE 128 /* welp, 175 means lines longer than 130 chars, which is a Fortran no no */ -#define MAX_TYPEDEFS 50 /* typedef history -ajb */ -#define MAXTOKENS 100 - -/* defines of system commands */ -#define UNIQSORT "/bin/sort -u" -#define CATCOMM "/bin/cat" -#define RMCOMM "/bin/rm" -#define MVCOMM "/bin/mv" - -#define DRIVER_LAYER 100 -#define MEDIATION_LAYER 200 - -enum coord_axis { COORD_X , COORD_Y , COORD_Z , COORD_C } ; -enum len_defined_how { DOMAIN_STANDARD , NAMELIST , CONSTANT } ; -enum type_type { SIMPLE , DERIVED } ; -enum proc_orient { ALL_Z_ON_PROC , ALL_X_ON_PROC , ALL_Y_ON_PROC } ; - -/* wrapping options */ -#define PERIOD_2PI 2 -#define PERIOD_OTHER 1 -#define PERIOD_NONE 0 - - -/* node_kind mask settings */ -#define FIELD 1 -#define PARAM 2 -#define RCONFIG 4 -#define FOURD 8 -#define MEMBER 16 -#define TYPE 32 -#define DIM 64 -#define MODNAME 128 -#define HALO 256 -#define PERIOD 512 -#define SWAP 1024 -#define CYCLE 2048 -#define XPOSE 4096 -#define FOURD1 8192 -#define BDYONLY 16384 - -#define RESTART 0x02000000 /* 25 */ -#define BOUNDARY 0x04000000 /* 26 */ -#define INTERP_DOWN 0x08000000 /* 27 */ -#define FORCE_DOWN 0x10000000 /* 28 */ -#define INTERP_UP 0x20000000 /* 29 */ -#define SMOOTH_UP 0x40000000 /* 20 */ -#define METADATA 0x80000000 /* 31 */ - - -#define REGISTRY_H -#endif - -#ifdef WIN32 -#define snprintf _snprintf -#endif - diff --git a/modules/openfast-registry/src/registry.hpp b/modules/openfast-registry/src/registry.hpp new file mode 100644 index 0000000000..53f3de5d5c --- /dev/null +++ b/modules/openfast-registry/src/registry.hpp @@ -0,0 +1,541 @@ +#ifndef REGISTRY_HPP +#define REGISTRY_HPP + +#include +#include +#include +#include +#include +#include +#include +#include + +std::string tolower(std::string s); + +// case-independent (ci) string less_than: returns true if s1 < s2 +struct ci_less +{ + // case-independent (ci) compare_less binary function + struct nocase_compare + { + bool operator()(const unsigned char &c1, const unsigned char &c2) const + { + return tolower(c1) < tolower(c2); + } + }; + bool operator()(const std::string &s1, const std::string &s2) const + { + return std::lexicographical_compare(s1.begin(), s1.end(), // source range + s2.begin(), s2.end(), // dest range + nocase_compare()); // comparison + } +}; + +enum class Period +{ + None, + TwoPi, +}; + +struct Module; +struct DataType; + +struct InterfaceData +{ + std::string name; + std::string name_short; + bool only_reals; + + InterfaceData(std::string name, std::string name_short, bool only_reals) + : name(name), name_short(name_short), only_reals(only_reals) + { + } +}; + +struct DimSpec +{ + size_t i; + bool is_deferred = false; + bool is_pointer = false; + std::string lower_bound = "1"; + std::string upper_bound = "-1"; + + DimSpec(std::string spec) + { + // Get indices of first colon and asterisk + auto i = spec.find(":"); + auto j = spec.find("*"); + + // If colon was found + if (i != std::string::npos) + { + // If colon is the only character, this is a deferred dimension + this->is_deferred = spec.size() == 1; + + // If colon isn't first, then parse the lower bound, otherwise 1 + this->lower_bound = i > 0 ? spec.substr(0, i) : "1"; + + // Parse the upper bound + this->upper_bound = this->is_deferred ? "-1" : spec.substr(i + 1); + } + // If asterisk was found + else if (j != std::string::npos) + { + this->is_deferred = true; + this->is_pointer = true; + } + // Otherwise, spec contains upper bound + else + { + this->lower_bound = "1"; + this->upper_bound = spec; + } + } +}; + +struct Field +{ + std::string name; + std::shared_ptr data_type; + std::vector dims; + std::string init_value = ""; + std::string desc = "-"; + std::string units = "-"; + Period gen_periodic = Period::None; + int rank = 0; + bool is_pointer = false; + bool is_allocatable = false; + bool is_target = false; + + Field(const std::string &name, std::shared_ptr const &type, const std::string &dims, + const std::string &ctrl, const std::string &init_value, const std::string &desc, + const std::string &units) + { + if (name[0] == '&') + { + this->name = name.substr(1); + this->is_target = true; + this->is_pointer = true; + this->is_allocatable = true; + } + else if (name[0] == '*') + { + this->name = name.substr(1); + this->is_pointer = true; + this->is_allocatable = true; + } + else + { + this->name = name; + } + + this->data_type = type; + + if (ctrl.compare("2pi") == 0) + { + this->gen_periodic = Period::TwoPi; + } + + if (desc.compare("-") != 0) + { + this->desc = desc; + } + + if (units.compare("-") != 0) + { + this->units = units; + } + + if (dims.compare("-") != 0) + { + // Parse dims, throw exception on error + if (this->parse_dims(dims) != 0) + { + throw std::invalid_argument("invalid dimensions: " + dims); + } + + // Add dimension number + for (size_t i = 0; i < this->dims.size(); ++i) + { + this->dims[i].i = i + 1; + } + + // Get field rank (number of dimensions) + this->rank = this->dims.size(); + + // Field is a pointer if any dim is a pointer + this->is_pointer |= std::any_of(this->dims.begin(), this->dims.end(), + [](const DimSpec &ds) + { return ds.is_pointer; }); + + // Field is allocatable if any dim is deferred + this->is_allocatable |= std::any_of(this->dims.begin(), this->dims.end(), + [](const DimSpec &ds) + { return ds.is_deferred; }); + } + + // If field is a pointer, initialize to null + if (this->is_pointer) + { + this->init_value = "null()"; + } + // If field is allocatable, then no initialization + else if (this->is_allocatable) + { + this->init_value = ""; + } + // If initialization is not empty + else if (init_value.compare("-") != 0) + { + this->init_value = init_value; + } + } + + int parse_dims(std::string dim_field) + { + // If no dimensions specified + if (dim_field.size() == 0) + return 0; + + // Remove leading and trailing braces + if (dim_field[0] == '{') + dim_field = dim_field.substr(1); + if (dim_field.back() == '}') + dim_field.pop_back(); + + // If dim field is only digits, parse number + if (std::all_of(dim_field.begin(), dim_field.end(), ::isdigit)) + { + this->dims.push_back(DimSpec(dim_field)); + return 0; + } + + // If all dims are colons or asterisks, no braces + if (std::all_of(dim_field.begin(), dim_field.end(), [](char c) + { return c == '*'; }) || + std::all_of(dim_field.begin(), dim_field.end(), [](char c) + { return c == ':'; })) + { + for (auto &dim : dim_field) + { + this->dims.push_back(DimSpec(std::string(1, dim))); + } + return 0; + } + + // Split by braces + std::regex split("\\}\\{"); + std::sregex_token_iterator iter(dim_field.begin(), dim_field.end(), split, -1); + std::sregex_token_iterator re_end; + for (; iter != re_end; ++iter) + { + this->dims.push_back(DimSpec(*iter)); + } + + return 0; + } +}; + +struct DataType +{ + enum class Tag + { + Integer, + Real, + Logical, + Character, + Derived, + }; + Tag tag; + + struct Basic + { + std::string name; + std::string type_fortran; + std::string string_len; + int bit_size = 0; + }; + Basic basic; + + struct Derived + { + std::string name; + std::string name_short; + std::string type_fortran; + std::shared_ptr module; + std::vector fields; + bool contains_mesh = false; + std::shared_ptr interface; + int max_rank = 0; + + bool only_contains_reals() + { + // Loop through fields + for (const auto &field : this->fields) + { + // Switch based on field data type + switch (field.data_type->tag) + { + + // Field is a derived type, so check it's fields and + // return false if it doesn't only contain reals + case Tag::Derived: + if (!field.data_type->derived.only_contains_reals()) + return false; + continue; + + // Field is a real, continue + case Tag::Real: + continue; + + // Field is not a real, return false + case Tag::Character: + case Tag::Integer: + case Tag::Logical: + return false; + } + } + + // Derived data type and all of its fields only contain reals + return true; + } + }; + Derived derived; + + // Constructor for basic type + DataType(const std::string &name, const std::string &type_fortran, const Tag &type, + const int bit_size = 0, const std::string &string_len = "") + : tag(type) + { + this->basic.name = name; + this->basic.type_fortran = type_fortran; + this->basic.string_len = string_len; + this->basic.bit_size = bit_size; + } + + // Constructor for derived type + DataType(std::shared_ptr mod, const std::string &name, + const std::string &name_short = "", const std::string &name_prefixed = "") + : tag(Tag::Derived) + { + this->derived.name = name; + this->derived.module = mod; + this->derived.name_short = name_short.empty() ? name : name_short; + this->derived.type_fortran = name_prefixed.empty() ? name : name_prefixed; + this->derived.contains_mesh = + (tolower(name).compare("meshtype") == 0) || (tolower(name).compare("meshmaptype") == 0); + } + + std::string c_type() + { + switch (this->tag) + { + case DataType::Tag::Integer: + return "int"; + case DataType::Tag::Logical: + return "bool"; + case DataType::Tag::Character: + return "char"; + case DataType::Tag::Real: + switch (this->basic.bit_size) + { + case 0: + return "float"; + case 32: + return "float"; + case 64: + return "double"; + } + case DataType::Tag::Derived: + return "invalid"; + } + return "invalid"; + } + + std::string c_types_binding() + { + switch (this->tag) + { + case DataType::Tag::Integer: + return "INTEGER(KIND=C_INT)"; + case DataType::Tag::Logical: + return "LOGICAL(KIND=C_BOOL)"; + case DataType::Tag::Character: + return "CHARACTER(KIND=C_CHAR), DIMENSION(" + this->basic.string_len + ")"; + case DataType::Tag::Real: + switch (this->basic.bit_size) + { + case 0: + return "REAL(KIND=C_FLOAT)"; + case 32: + return "REAL(KIND=C_FLOAT)"; + case 64: + return "REAL(KIND=C_DOUBLE)"; + } + case DataType::Tag::Derived: + return "INVALID"; + } + return "INVALID"; + } +}; + +struct Parameter +{ + std::string name; + std::shared_ptr type; + std::string value = ""; + std::string desc = "-"; + std::string units = "-"; + + Parameter(const std::string &name, std::shared_ptr &type, const std::string &value, + const std::string &desc, const std::string &units) + { + this->name = name; + this->type = type; + if (value.compare("-") != 0) + { + this->value = value; + } + if (desc.compare("-") != 0) + { + this->desc = desc; + } + if (desc.compare("-") != 0) + { + this->desc = desc; + } + } +}; + +struct Module +{ + std::string name; + std::string nickname; + std::vector params; + std::map, ci_less> data_types; + std::vector ddt_names; + bool is_root = false; + + Module(std::string name, std::string nickname, bool is_root) + : name(name), nickname(nickname), is_root(is_root) + { + } +}; + +struct Registry +{ + std::vector include_dirs = {"."}; + std::set include_files; + std::vector use_modules; + std::map, ci_less> interface_map; + std::map, ci_less> modules; + std::map, ci_less> data_types; + bool gen_c_code = false; + bool no_extrap_interp = false; + + Registry() + { + // Basic types + auto IntKi = + std::make_shared("IntKi", "INTEGER(IntKi)", DataType::Tag::Integer, 32); + auto SiKi = std::make_shared("SiKi", "REAL(SiKi)", DataType::Tag::Real, 32); + auto R4Ki = std::make_shared("R4Ki", "REAL(R4Ki)", DataType::Tag::Real, 32); + auto ReKi = std::make_shared("ReKi", "REAL(ReKi)", DataType::Tag::Real); + auto R8Ki = std::make_shared("R8Ki", "REAL(R8Ki)", DataType::Tag::Real, 64); + auto DbKi = std::make_shared("DbKi", "REAL(DbKi)", DataType::Tag::Real, 64); + auto logical = std::make_shared("Logical", "LOGICAL", DataType::Tag::Logical); + + // Derived types + auto mesh = std::make_shared(nullptr, "MeshType", "MeshType", "MeshType"); + auto dll = std::make_shared(nullptr, "DLL_Type"); + + // Map of data types + this->data_types = std::map, ci_less>{ + {"integer", IntKi}, + {"intki", IntKi}, + {"b4ki", IntKi}, + {"real", ReKi}, + {"reki", ReKi}, + {"siki", SiKi}, + {"r4ki", R4Ki}, + {"r8ki", R8Ki}, + {"doubleprecision", DbKi}, + {"dbki", DbKi}, + {"logical", logical}, + {"meshtype", mesh}, + {"dll_type", dll}, + }; + + this->interface_map = std::map, ci_less>{ + {"InitInputType", std::make_shared("InitInputType", "InitInput", false)}, + {"InitOutputType", + std::make_shared("InitOutputType", "InitOutput", false)}, + {"InputType", std::make_shared("InputType", "Input", true)}, + {"OutputType", std::make_shared("OutputType", "Output", true)}, + {"ContinuousStateType", + std::make_shared("ContinuousStateType", "ContState", true)}, + {"DiscreteStateType", + std::make_shared("DiscreteStateType", "DiscState", true)}, + {"ConstraintStateType", + std::make_shared("ConstraintStateType", "ConstrState", true)}, + {"OtherStateType", + std::make_shared("OtherStateType", "OtherState", false)}, + {"MiscVarType", std::make_shared("MiscVarType", "Misc", false)}, + {"ParameterType", std::make_shared("ParameterType", "Param", false)}, + {"PartialOutputPInputType", + std::make_shared("PartialOutputPInputType", "dYdu", true)}, + {"PartialContStatePInputType", + std::make_shared("PartialContStatePInputType", "dXdu", true)}, + {"PartialDiscStatePInputType", + std::make_shared("PartialDiscStatePInputType", "dXddu", true)}, + {"PartialConstrStatePInputType", + std::make_shared("PartialConstrStatePInputType", "dZdu", true)}, + }; + } + + // Parsing + void parse(const std::string &file_name, const int recurse_level); + int parse_line(const std::string &line, std::vector &fields_prev, + const int recurse_level); + std::shared_ptr find_data_type(const std::string &type_name, + std::shared_ptr mod = nullptr) + { + // Pointer to type + std::shared_ptr data_type; + + // Get map of data types to search + // If module was provided, search it; otherwise, search registry + auto &data_types = mod == nullptr ? this->data_types : mod->data_types; + + // Search for type in registry, return if found + auto it = data_types.find(type_name); + if (it != data_types.end()) + { + return it->second; + } + + // If type starts with character (string type), build type and return it + if (tolower(type_name).compare(0, 9, "character") == 0) + { + // Get string length + auto string_len = type_name.substr(10, type_name.size() - 11); + + // Build type + data_type = std::make_shared(type_name, type_name, DataType::Tag::Character, + 0, string_len); + + // Add type to registry + this->data_types[type_name] = data_type; + return data_type; + } + + return nullptr; + } + + // Output + void gen_module_files(std::string const &out_dir); + void gen_fortran_module(const Module &mod, const std::string &out_dir); + void gen_c_module(const Module &mod, const std::string &out_dir); +}; + +#endif diff --git a/modules/openfast-registry/src/registry_gen_c.cpp b/modules/openfast-registry/src/registry_gen_c.cpp new file mode 100644 index 0000000000..b2ce5e60cc --- /dev/null +++ b/modules/openfast-registry/src/registry_gen_c.cpp @@ -0,0 +1,116 @@ +#include +#include + +#include "registry.hpp" + +void Registry::gen_c_module(const Module &mod, const std::string &out_dir) +{ + auto file_name = mod.name + "_Types.h"; + auto file_path = out_dir + "/" + file_name; + + // Write message that file is being generated + std::cerr << "generating " << file_name << std::endl; + + // Open output file, return if error + std::ofstream w(file_path); + if (!w) + { + std::cerr << "Error creating module file: '" << file_path << "'" << std::endl; + exit(EXIT_FAILURE); + } + + // Write file header + w << "//!STARTOFREGISTRYGENERATEDFILE '" << file_name << "'\n"; + w << "//!\n"; + w << "//! WARNING This file is generated automatically by the FAST registry.\n"; + w << "//! Do not edit. Your changes to this file will be lost.\n"; + w << "//!\n"; + w << "\n"; + w << "#ifndef _" << mod.name << "_TYPES_H\n"; + w << "#define _" << mod.name << "_TYPES_H\n\n"; + w << "\n"; + w << "#ifdef _WIN32 //define something for Windows (32-bit)\n"; + w << "# include \"stdbool.h\"\n"; + w << "# define CALL __declspec( dllexport )\n"; + w << "#elif _WIN64 //define something for Windows (64-bit)\n"; + w << "# include \"stdbool.h\"\n"; + w << "# define CALL __declspec( dllexport ) \n"; + w << "#else\n"; + w << "# include \n"; + w << "# define CALL \n"; + w << "#endif\n"; + w << "\n\n"; + + // Loop through data types in module + for (auto &dt_name : mod.ddt_names) + { + // Get derive data types in module + auto it = mod.data_types.find(dt_name); + auto &dt = *it->second; + if (dt.tag != DataType::Tag::Derived) + continue; + auto &ddt = dt.derived; + + w << " typedef struct " << ddt.type_fortran << " {\n"; + w << " void * object ;\n"; + for (const auto &field : ddt.fields) + { + if (field.data_type->tag == DataType::Tag::Derived) + { + // TODO:Support derived types + } + else // Basic Type + { + if (field.is_allocatable) + { + w << " " << field.data_type->c_type() << " * " << field.name << " ; int " + << field.name << "_Len ;"; + } + else if (field.data_type->tag == DataType::Tag::Character) + { + if (field.rank == 0) + { + w << " " << field.data_type->c_type() << " " << field.name << "[" + << field.data_type->basic.string_len << "] ;"; + } + } + else + { + w << " " << field.data_type->c_type() << " " << field.name << " ;"; + } + } + for (int i = 0; i < field.rank; i++) + { + if (!field.is_allocatable && + (field.data_type->tag != DataType::Tag::Character || field.rank == 0)) + w << "[" << field.dims[i].upper_bound << "-" << field.dims[i].lower_bound + << "+1] ;"; + } + w << "\n"; + } + w << " } " << ddt.type_fortran << "_t ;\n"; + } + + // Write struct containing all of the module's derived types + w << " typedef struct " << mod.nickname << "_UserData {\n"; + for (auto &dt_name : mod.ddt_names) + { + // Get derived data types with interfaces + auto it = mod.data_types.find(dt_name); + auto &dt = *it->second; + if (dt.tag != DataType::Tag::Derived) + continue; + auto &ddt = dt.derived; + if (ddt.interface == nullptr) + continue; + + // Write name + w << " " << std::setw(30) << std::left << ddt.type_fortran + "_t" + << " " << mod.nickname << "_" << ddt.interface->name_short << " ;\n"; + } + w << " } " << mod.nickname << "_t ;\n"; + + // Write file footer + w << "\n#endif // _" << mod.name << "_TYPES_H\n\n\n"; + w << "//!ENDOFREGISTRYGENERATEDFILE\n"; +} \ No newline at end of file diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp new file mode 100644 index 0000000000..c962a2bcc2 --- /dev/null +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -0,0 +1,1832 @@ +#include + +#include "registry.hpp" +#include "templates.hpp" + +const int MAXRECURSE = 9; + +void gen_ExtrapInterp(std::ostream &w, const Module &mod, std::string type_name_long, + std::string type_kind, const bool useModPrefix); +void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, + const bool gen_c_code); +void gen_destroy(std::ostream &out, const Module &mod, const DataType::Derived &ddt, + const bool gen_c_code); +void gen_pack(std::ostream &out, const Module &mod, const DataType::Derived &ddt, + const bool gen_c_code); +void gen_unpack(std::ostream &out, const Module &mod, const DataType::Derived &ddt, + bool gen_c_code); +void gen_copy_c2f(std::ostream &w, const Module &mod, const DataType::Derived &ddt); +void gen_copy_f2c(std::ostream &w, const Module &mod, const DataType::Derived &ddt); + +std::string dimstr(size_t d) +{ + switch (d) + { + case 0: + return ""; + case 1: + return "(i1)"; + case 2: + return "(i1,i2)"; + case 3: + return "(i1,i2,i3)"; + case 4: + return "(i1,i2,i3,i4)"; + case 5: + return "(i1,i2,i3,i4,i5)"; + } + return " REGISTRY ERROR TOO MANY DIMS "; +} + +std::string dimstr_c(size_t d) +{ + switch (d) + { + case 0: + return ""; + case 1: + return "[i1]"; + case 2: + return "[i2][i1]"; + case 3: + return "[i3][i2][i1]"; + case 4: + return "[i4][i3][i2][i1]"; + case 5: + return "[i5][i4][i3][i2][i1]"; + } + return " REGISTRY ERROR TOO MANY DIMS "; +} + +void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) +{ + // Create file name and path + auto file_name = mod.name + "_Types.f90"; + auto file_path = out_dir + "/" + file_name; + std::cerr << "generating " << file_name << std::endl; + + // Open file, exit if error + std::ofstream w(file_path); + if (!w) + { + std::cerr << "Error creating module file: '" << file_path << "'" << std::endl; + exit(EXIT_FAILURE); + } + + // Write preamble + w << std::regex_replace(FAST_preamble.substr(1), std::regex("ModuleName"), mod.name); + + // Output USE statements for non-root modules + for (auto const &mod : this->use_modules) + if (tolower(mod).compare("nwtc_library") != 0) + w << "USE " << mod << "_Types\n"; + + // If this is the NWTC Library, we're not going to print "USE NWTC_Library" + if (tolower(mod.name).compare("nwtc_library") == 0) + w << "USE SysSubs\n"; + else + w << "USE NWTC_Library\n"; + + w << "IMPLICIT NONE\n"; + + // Write parameters to file + for (const auto ¶m : mod.params) + { + w << " " << param.type->basic.type_fortran << ", PUBLIC, PARAMETER :: " << param.name; + + if (!param.value.empty()) + w << " = " << param.value; + + if (param.desc.compare("-") != 0 || param.units.compare("-") != 0) + w << " ! " << param.desc << " [" << param.units << "]"; + + w << "\n"; + } + + // Loop through data type names in module + for (auto &dt_name : mod.ddt_names) + { + // Get derived data type + auto &ddt = mod.data_types.find(dt_name)->second->derived; + + // If derived data type should only contain reals, + // verify that it does, otherwise exit with error + if ((ddt.interface != nullptr) && ddt.interface->only_reals) + if (!ddt.only_contains_reals()) + exit(EXIT_FAILURE); + + // Write derived type header + w << "! ========= " << ddt.type_fortran << (this->gen_c_code ? "_C" : "") << " =======\n"; + + // If requested, write C version of derived data type + if (this->gen_c_code) + { + w << " TYPE, BIND(C) :: " << ddt.type_fortran << "_C\n"; + w << " TYPE(C_PTR) :: object = C_NULL_PTR\n"; + + for (auto &field : ddt.fields) + { + if (field.data_type->tag != DataType::Tag::Derived) + { + if (field.rank == 0) + { + auto c = field.data_type->c_types_binding(); + w << " " << field.data_type->c_types_binding() + << " :: " << field.name << " \n"; + } + else + { + if (field.is_allocatable) + { + w << " TYPE(C_ptr) :: " << field.name << " = C_NULL_PTR \n"; + w << " INTEGER(C_int) :: " << field.name << "_Len = 0 \n"; + } + else if (field.data_type->tag != DataType::Tag::Character) + { + w << " TYPE(C_PTR) :: " << field.name << "("; + for (int i = 0; i < field.rank; i++) + { + w << (i > 0 ? "," : "") << field.dims[i].upper_bound; + } + w << ")\n"; + } + } + } + } + w << " END TYPE " << ddt.type_fortran << "_C\n"; + } + + // Write Fortran derived data type + w << " TYPE, PUBLIC :: " << ddt.type_fortran << "\n"; + if (this->gen_c_code) + w << " TYPE( " << ddt.type_fortran << "_C ) :: C_obj\n"; + + // Loop through fields + for (auto &field : ddt.fields) + { + if (field.data_type->tag == DataType::Tag::Derived) + { + w << " TYPE(" << field.data_type->derived.type_fortran << ") "; + } + else if (this->gen_c_code && field.is_pointer) + { + auto c = field.data_type->c_types_binding(); + w << " " << field.data_type->c_types_binding() << " "; + } + else + { + w << " " << field.data_type->basic.type_fortran << " "; + } + + if (field.rank > 0) + { + w << ", DIMENSION("; + + // If field is allocatable + if (field.is_allocatable) + { + for (int i = 0; i < field.rank; i++) + w << (i == 0 ? ":" : ",:"); + + w << "), " << (field.is_pointer ? "POINTER " : "ALLOCATABLE "); + } + // Field is not allocatable + else + { + bool first = true; + for (const auto &dim : field.dims) + { + w << (first ? "" : ",") << dim.lower_bound << ":" + << dim.upper_bound; + first = false; + } + w << ") "; + } + } + else if (field.is_pointer) + { + w << ", POINTER"; + } + + w << " :: " << field.name << " "; + + if (field.is_pointer) + { + w << "=> NULL() "; + } + else if (field.rank == 0 && !field.init_value.empty()) + { + w << "= " << field.init_value << " "; + } + + if (field.desc.compare("-") != 0 || field.units.compare("-") != 0) + { + w << " !< " << field.desc << " [" << field.units << "]"; + } + + w << "\n"; + } + w << " END TYPE " << ddt.type_fortran << "\n"; + w << "! =======================\n"; + } + + w << "CONTAINS\n"; + + // Loop through derived data types + for (auto &dt_name : mod.ddt_names) + { + // Get derived data type + auto &ddt = mod.data_types.find(dt_name)->second->derived; + + // Generate copy, destroy, pack, and unpack routines + gen_copy(w, mod, ddt, this->gen_c_code); + gen_destroy(w, mod, ddt, this->gen_c_code); + gen_pack(w, mod, ddt, this->gen_c_code); + gen_unpack(w, mod, ddt, this->gen_c_code); + + // If C code generation requested + if (this->gen_c_code) + { + // Generate C <-> Fortran copy functions + gen_copy_c2f(w, mod, ddt); + gen_copy_f2c(w, mod, ddt); + } + } + + // If this is the AirfoilInfo module, generate routines for Output and UA_BL_Type + if (tolower(mod.name).compare("airfoilinfo") == 0) + { + gen_ExtrapInterp(w, mod, "OutputType", "ReKi", 1); + gen_ExtrapInterp(w, mod, "UA_BL_Type", "ReKi", 1); + } + else if (!this->no_extrap_interp) + { + // If this is the DBEMT module make extrap/interp for ElementInput + if (tolower(mod.name).compare("dbemt") == 0) + gen_ExtrapInterp(w, mod, "ElementInputType", "DbKi", 1); + + // Generate extrap/interp routines for module input and output types + gen_ExtrapInterp(w, mod, "InputType", "DbKi", 1); + gen_ExtrapInterp(w, mod, "OutputType", "DbKi", 1); + } + + w << "END MODULE " << mod.name << "_Types\n"; + w << "!ENDOFREGISTRYGENERATEDFILE\n"; +} + +void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, + const bool gen_c_code) +{ + w << " SUBROUTINE " << mod.nickname << "_Copy" << ddt.name_short << "( Src" << ddt.name_short + << "Data, Dst" << ddt.name_short << "Data, CtrlCode, ErrStat, ErrMsg )\n"; + w << " TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh ? "INOUT" : "IN") + << ") :: Src" << ddt.name_short << "Data\n"; + w << " TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: Dst" << ddt.name_short << "Data\n"; + w << " INTEGER(IntKi), INTENT(IN ) :: CtrlCode\n"; + w << " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n"; + w << " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"; + w << "! Local \n"; + w << " INTEGER(IntKi) :: i,j,k\n"; + for (int d = 1; d <= ddt.max_rank; d++) + w << " INTEGER(IntKi) :: i" << d << ", i" << d << "_l, i" << d + << "_u ! bounds (upper/lower) for an array dimension " << d << "\n"; + w << " INTEGER(IntKi) :: ErrStat2\n"; + w << " CHARACTER(ErrMsgLen) :: ErrMsg2\n"; + w << " CHARACTER(*), PARAMETER :: RoutineName = '" << mod.nickname << "_Copy" + << ddt.name_short << "'\n"; + w << "! \n"; + w << " ErrStat = ErrID_None\n"; + w << " ErrMsg = \"\"\n"; + + // Loop through fields + for (auto &field : ddt.fields) + { + std::string alloc_assoc = field.is_pointer ? "ASSOCIATED" : "ALLOCATED"; + std::string src = "Src" + ddt.name_short + "Data%" + field.name; + std::string dst = "Dst" + ddt.name_short + "Data%" + field.name; + + // If field is a non-target pointer, set the associate the destination + // pointer with the source pointer + if (field.is_pointer && !field.is_target) + { + w << " " << dst << " => " << src << "\n"; + continue; + } + + // If field is an allocatable array + if (field.is_allocatable) + { + w << "IF (" << alloc_assoc << "(" << src << ")) THEN\n"; + + std::string dims; + for (int d = 1; d <= field.rank; d++) + { + w << " i" << d << "_l = LBOUND(" << src << "," << d << ")\n"; + w << " i" << d << "_u = UBOUND(" << src << "," << d << ")\n"; + dims += (d == 1 ? "(i" : "i") + std::to_string(d) + "_l:i" + + std::to_string(d) + "_u" + (d == field.rank ? ")" : ","); + } + + w << " IF (.NOT. " << alloc_assoc << "(" << dst << ")) THEN \n"; + w << " ALLOCATE(" << dst << dims << ",STAT=ErrStat2)\n"; + w << " IF (ErrStat2 /= 0) THEN \n"; + w << " CALL SetErrStat(ErrID_Fatal, 'Error allocating " << dst + << ".', ErrStat, ErrMsg,RoutineName)\n"; + w << " RETURN\n"; + w << " END IF\n"; + + // bjj: this needs to be updated if we've got multidimensional arrays + if (gen_c_code && field.is_pointer) + { + std::string dst_c = "Dst" + ddt.name_short + "Data%C_obj%" + field.name; + w << " " << dst_c << "_Len = SIZE(" << dst << ")\n"; + w << " IF (" << dst_c << "_Len > 0) &\n"; + w << " " << dst_c << " = C_LOC( " << dst << "("; + for (int d = 1; d <= field.rank; d++) + { + w << (d > 1 ? "," : "") << " i" << d << "_l"; + } + w << " ) )\n"; + } + + w << " END IF\n"; + } + + // includes mesh and dll_type + if (field.data_type->tag == DataType::Tag::Derived) + { + auto &ddt = field.data_type->derived; + + for (int d = field.rank; d >= 1; d--) + { + w << " DO i" << d << " = LBOUND(" << src << "," << d << "), UBOUND(" << src + << "," << d << ")\n"; + } + + if (ddt.name_short.compare("MeshType") == 0) + { + w << " CALL MeshCopy( " << src << dimstr(field.rank) << ", " << dst + << dimstr(field.rank) << ", CtrlCode, ErrStat2, ErrMsg2 )\n"; + w << " CALL SetErrStat(ErrStat2, ErrMsg2, " + "ErrStat, ErrMsg, RoutineName)\n"; + w << " IF (ErrStat>=AbortErrLev) RETURN\n"; + } + else if (ddt.name_short.compare("DLL_Type") == 0) + { + w << " " << dst << " = " << src << "\n"; + } + else + { + w << " CALL " << ddt.module->nickname << "_Copy" + << (ddt.interface == nullptr ? tolower(ddt.name_short) : ddt.name_short) << "( " + << src << dimstr(field.rank) << ", " << dst << dimstr(field.rank) + << ", CtrlCode, ErrStat2, ErrMsg2 )\n"; + w << " CALL SetErrStat(ErrStat2, ErrMsg2, " + "ErrStat, ErrMsg,RoutineName)\n"; + w << " IF (ErrStat>=AbortErrLev) RETURN\n"; + } + + for (auto &d : field.dims) + w << " ENDDO\n"; + } + else + { + w << " " << dst << " = " << src << "\n"; + if (gen_c_code && !field.is_pointer) + { + if (field.rank == 0) // scalar of any type OR a character array + { + std::string tmp = ddt.name_short + "Data%C_obj%" + field.name; + w << " Dst" << tmp << " = Src" << tmp << "\n"; + } + } + } + + // close IF (check on allocatable array) + if (field.is_allocatable) + w << "ENDIF\n"; + } + + w << " END SUBROUTINE " << mod.nickname << "_Copy" << ddt.name_short << "\n" + << std::endl; +} + +void gen_destroy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, + const bool gen_c_code) +{ + auto ddt_data = ddt.name_short + "Data"; + auto routine_name = mod.nickname + "_Destroy" + ddt.name_short; + + w << " SUBROUTINE " << routine_name << "( " << ddt_data << ", ErrStat, ErrMsg )\n"; + w << " TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << ddt_data << "\n"; + w << " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n"; + w << " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"; + w << " \n"; + w << " INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 \n"; + w << " INTEGER(IntKi) :: ErrStat2\n"; + w << " CHARACTER(ErrMsgLen) :: ErrMsg2\n"; + w << " CHARACTER(*), PARAMETER :: RoutineName = '" << routine_name << "'\n\n"; + w << " ErrStat = ErrID_None\n"; + w << " ErrMsg = \"\"\n"; + w << "\n"; + + for (auto &field : ddt.fields) + { + // Combine data name and field name + auto ddt_field = ddt_data + "%" + field.name; + + // If non-target pointer field, just nullify pointer + if (field.is_pointer && !field.is_target) + { + w << "NULLIFY(" << ddt_field << ")\n"; + continue; + } + + // If field is an array with deferred dimensions + if (field.is_allocatable) + { + w << "IF (" << (field.is_pointer ? "ASSOCIATED" : "ALLOCATED") << "(" << ddt_field + << ")) THEN\n"; + } + + // If field is a derived data type, loop through elements and destroy + if (field.data_type->tag == DataType::Tag::Derived) + { + for (int d = field.rank; d >= 1; d--) + { + w << "DO i" << d << " = LBOUND(" << ddt_field << "," << d << "), UBOUND(" + << ddt_field << "," << d << ")\n"; + } + + auto ddt_field_dims = ddt_field + dimstr(field.rank); + + if (field.data_type->derived.name.compare("MeshType") == 0) + { + w << " CALL MeshDestroy( " << ddt_field_dims << ", ErrStat2, ErrMsg2 )\n"; + w << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"; + } + else if (field.data_type->derived.name.compare("DLL_Type") == 0) + { + w << " CALL FreeDynamicLib( " << ddt_field_dims << ", ErrStat2, ErrMsg2 )\n"; + w << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"; + } + else + { + // If field is a non-target pointer, just nullify, don't deallocate + if (field.is_pointer && !field.is_target) + { + w << " NULLIFY(" << ddt_field_dims << ")\n"; + } + else + { + std::string indent(""); + if (field.is_target) + { + w << " IF (ASSOCIATED(" << ddt_field_dims << ")) THEN\n"; + indent = " "; + } + w << indent << " CALL " << field.data_type->derived.module->nickname << "_Destroy" + << field.data_type->derived.name_short << "( " << ddt_field_dims + << ", ErrStat2, ErrMsg2 )\n"; + w << indent << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"; + if (field.is_target) + w << " ENDIF\n"; + } + } + + // Close for loops + for (int d = field.rank; d >= 1; d--) + w << "ENDDO\n"; + } + + if (field.is_allocatable) + { + w << " DEALLOCATE(" << ddt_field << ")\n"; + + if (gen_c_code && field.is_pointer) + { + auto ddt_field_c = ddt_data + "%C_obj%" + field.name; + w << " " << ddt_field_c << " = C_NULL_PTR\n"; + w << " " << ddt_field_c << "_Len = 0\n"; + } + w << "ENDIF\n"; + } + } + + w << " END SUBROUTINE " << mod.nickname << "_Destroy" << ddt.name_short << "\n\n"; +} + +void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, + const bool gen_c_code) +{ + auto ddt_data = ddt.name_short + "Data"; + auto routine_name = mod.nickname + "_Pack" + ddt.name_short; + + w << " SUBROUTINE " << routine_name + << "( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly )\n"; + w << " REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:)\n"; + w << " REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:)\n"; + w << " INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:)\n"; + w << " TYPE(" << ddt.type_fortran << "), INTENT(IN) :: InData\n"; + w << " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n"; + w << " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"; + w << " LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly\n"; + w << " ! Local variables\n"; + w << " INTEGER(IntKi) :: Re_BufSz\n"; + w << " INTEGER(IntKi) :: Re_Xferred\n"; + w << " INTEGER(IntKi) :: Db_BufSz\n"; + w << " INTEGER(IntKi) :: Db_Xferred\n"; + w << " INTEGER(IntKi) :: Int_BufSz\n"; + w << " INTEGER(IntKi) :: Int_Xferred\n"; + w << " INTEGER(IntKi) :: i,i1,i2,i3,i4,i5\n"; + w << " LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers\n"; + w << " INTEGER(IntKi) :: ErrStat2\n"; + w << " CHARACTER(ErrMsgLen) :: ErrMsg2\n"; + w << " CHARACTER(*), PARAMETER :: RoutineName = '" << routine_name << "'\n"; + + w << " ! buffers to store subtypes, if any\n"; + w << " REAL(ReKi), ALLOCATABLE :: Re_Buf(:)\n"; + w << " REAL(DbKi), ALLOCATABLE :: Db_Buf(:)\n"; + w << " INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:)\n\n"; + + w << " OnlySize = .FALSE.\n"; + w << " IF ( PRESENT(SizeOnly) ) THEN\n"; + w << " OnlySize = SizeOnly\n"; + w << " ENDIF\n"; + w << " !\n"; + + w << " ErrStat = ErrID_None\n"; + w << " ErrMsg = \"\"\n"; + w << " Re_BufSz = 0\n"; + w << " Db_BufSz = 0\n"; + w << " Int_BufSz = 0\n"; + + bool frst = true; + + // Loop through fields in derived data type + for (auto &field : ddt.fields) + { + // Skip non-target pointer fields + if (field.is_pointer && !field.is_target) + continue; + + auto assoc_alloc = field.is_pointer ? "ASSOCIATED" : "ALLOCATED"; + auto field_dims = field.name + dimstr(field.rank); + + // If this field is allocatable + if (field.is_allocatable) + { + w << " Int_BufSz = Int_BufSz + 1 ! " << field.name << " allocated yes/no\n"; + w << " IF ( " << assoc_alloc << "(InData%" << field.name << ") ) THEN\n"; + w << " Int_BufSz = Int_BufSz + 2*" << field.rank << " ! " << field.name + << " upper/lower bounds for each dimension\n"; + } + + // call individual routines to pack data from subtypes: + if (field.data_type->tag == DataType::Tag::Derived) + { + auto &field_ddt = field.data_type->derived; + if (frst) + { + w << " ! Allocate buffers for subtypes, if any (we'll get sizes from these) \n"; + frst = false; + } + + // Loop through dims and generate DO loops + for (int d = field.rank; d >= 1; d--) + w << " DO i" << d << " = LBOUND(InData%" << field.name << "," << d + << "), UBOUND(InData%" << field.name << "," << d << ")\n"; + + // Increment buffer size to store allocated flag, lower bound, upper bound + w << " Int_BufSz = Int_BufSz + 3 ! " << field.name + << ": size of buffers for each call to pack subtype\n"; + + // Call pack function based on type + if (field_ddt.name.compare("MeshType") == 0) + { + w << " CALL MeshPack( InData%" << field_dims + << ", Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! " << field.name + << " \n"; + } + else if (field_ddt.name.compare("DLL_Type") == 0) + { + w << " CALL DLLTypePack( InData%" << field_dims + << ", Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! " << field.name + << " \n"; + } + else if (field.data_type->tag == DataType::Tag::Derived) + { + w << " CALL " << field_ddt.module->nickname << "_Pack" << field_ddt.name_short + << "( Re_Buf, Db_Buf, Int_Buf, InData%" << field_dims + << ", ErrStat2, ErrMsg2, .TRUE. ) ! " << field.name << " \n"; + } + + w << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"; + w << " IF (ErrStat >= AbortErrLev) RETURN\n\n"; + + w << " IF(ALLOCATED(Re_Buf)) THEN ! " << field.name << "\n"; + w << " Re_BufSz = Re_BufSz + SIZE( Re_Buf )\n"; + w << " DEALLOCATE(Re_Buf)\n"; + w << " END IF\n"; + + w << " IF(ALLOCATED(Db_Buf)) THEN ! " << field.name << "\n"; + w << " Db_BufSz = Db_BufSz + SIZE( Db_Buf )\n"; + w << " DEALLOCATE(Db_Buf)\n"; + w << " END IF\n"; + + w << " IF(ALLOCATED(Int_Buf)) THEN ! " << field.name << "\n"; + w << " Int_BufSz = Int_BufSz + SIZE( Int_Buf )\n"; + w << " DEALLOCATE(Int_Buf)\n"; + w << " END IF\n"; + + for (int d = field.rank; d >= 1; d--) + w << " END DO\n"; + } + // intrinsic data types + else + { + // do all dimensions of arrays (no need for loop over i%d) + + std::string size = field.rank > 0 ? "SIZE(InData%" + field.name + ")" : "1"; + + if (field.data_type->tag == DataType::Tag::Real) + { + if (field.data_type->basic.bit_size == 64) + w << " Db_BufSz = Db_BufSz + " << size << " ! " << field.name << "\n"; + else + w << " Re_BufSz = Re_BufSz + " << size << " ! " << field.name << "\n"; + } + else if (field.data_type->tag == DataType::Tag::Integer || + field.data_type->tag == DataType::Tag::Logical) + { + w << " Int_BufSz = Int_BufSz + " << size << " ! " << field.name << "\n"; + } + else if (field.data_type->tag == DataType::Tag::Character) + { + w << " Int_BufSz = Int_BufSz + " << size << "*LEN(InData%" << field.name + << ") ! " << field.name << "\n"; + } + } + + // Close IF ALLOCATED statement + if (field.is_allocatable) + w << " END IF\n"; + } + + // Allocate buffers + w << " IF ( Re_BufSz .GT. 0 ) THEN \n"; + w << " ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 )\n"; + w << " IF (ErrStat2 /= 0) THEN \n"; + w << " CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName)\n"; + w << " RETURN\n"; + w << " END IF\n"; + w << " END IF\n"; + + w << " IF ( Db_BufSz .GT. 0 ) THEN \n"; + w << " ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 )\n"; + w << " IF (ErrStat2 /= 0) THEN \n"; + w << " CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName)\n"; + w << " RETURN\n"; + w << " END IF\n"; + w << " END IF\n"; + + w << " IF ( Int_BufSz .GT. 0 ) THEN \n"; + w << " ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 )\n"; + w << " IF (ErrStat2 /= 0) THEN \n"; + w << " CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName)\n"; + w << " RETURN\n"; + w << " END IF\n"; + w << " END IF\n"; + w << " IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them)\n\n"; + + if (gen_c_code) + { + w << " IF (C_ASSOCIATED(InData%C_obj%object)) "; + w << "CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName)\n\n"; + } + + w << " Re_Xferred = 1\n"; + w << " Db_Xferred = 1\n"; + w << " Int_Xferred = 1\n\n"; + + std::string mainIndent = ""; + + // Pack data + for (auto &field : ddt.fields) + { + // Skip pack non-target pointer fields + if (field.is_pointer && !field.is_target) + continue; + + auto assoc_alloc = field.is_pointer ? "ASSOCIATED" : "ALLOCATED"; + auto field_dims = field.name + dimstr(field.rank); + + if (field.is_allocatable) + { + // store whether the data type is allocated and the bounds of each dimension + w << " IF ( .NOT. " << assoc_alloc << "(InData%" << field.name << ") ) THEN\n"; + w << " IntKiBuf( Int_Xferred ) = 0\n"; // not allocated + w << " Int_Xferred = Int_Xferred + 1\n"; + w << " ELSE\n"; + w << " IntKiBuf( Int_Xferred ) = 1\n"; // allocated + w << " Int_Xferred = Int_Xferred + 1\n"; + for (int d = 1; d <= field.rank; d++) + { + w << " IntKiBuf( Int_Xferred ) = LBOUND(InData%" << field.name << "," << d + << ")\n"; + w << " IntKiBuf( Int_Xferred + 1) = UBOUND(InData%" << field.name << "," << d + << ")\n"; + w << " Int_Xferred = Int_Xferred + 2\n"; + } + w << "\n"; + mainIndent = " "; + } + else + { + mainIndent = ""; + } + + // call individual routines to pack data from subtypes: + if (field.data_type->tag == DataType::Tag::Derived) + { + if (frst == 1) + { + w << " ! Allocate buffers for subtypes, if any (we'll get sizes from these) \n"; + frst = false; + } + + for (int d = field.rank; d >= 1; d--) + { + w << " DO i" << d << " = LBOUND(InData%" << field.name << "," << d + << "), UBOUND(InData%" << field.name << "," << d << ")\n"; + } + + if (field.data_type->derived.name.compare("MeshType") == 0) + { + w << " CALL MeshPack( InData%" << field_dims + << ", Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! " << field.name + << " \n"; + } + else if (field.data_type->derived.name.compare("DLL_Type") == 0) + { + w << " CALL DLLTypePack( InData%" << field_dims + << ", Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! " << field.name + << " \n"; + } + else + { + w << " CALL " << field.data_type->derived.module->nickname << "_Pack" + << field.data_type->derived.name_short << "( Re_Buf, Db_Buf, Int_Buf, InData%" << field_dims + << ", ErrStat2, ErrMsg2, OnlySize ) ! " << field.name << " \n"; + } + + w << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"; + w << " IF (ErrStat >= AbortErrLev) RETURN\n\n"; + + w << " IF(ALLOCATED(Re_Buf)) THEN\n"; + w << " IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1\n"; + w << " IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf\n"; + w << " Re_Xferred = Re_Xferred + SIZE(Re_Buf)\n"; + w << " DEALLOCATE(Re_Buf)\n"; + w << " ELSE\n"; + w << " IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1\n"; + w << " ENDIF\n"; + + w << " IF(ALLOCATED(Db_Buf)) THEN\n"; + w << " IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1\n"; + w << " IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf\n"; + w << " Db_Xferred = Db_Xferred + SIZE(Db_Buf)\n"; + w << " DEALLOCATE(Db_Buf)\n"; + w << " ELSE\n"; + w << " IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1\n"; + w << " ENDIF\n"; + + w << " IF(ALLOCATED(Int_Buf)) THEN\n"; + w << " IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1\n"; + w << " IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf\n"; + w << " Int_Xferred = Int_Xferred + SIZE(Int_Buf)\n"; + w << " DEALLOCATE(Int_Buf)\n"; + w << " ELSE\n"; + w << " IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1\n"; + w << " ENDIF\n"; + + for (int d = field.rank; d >= 1; d--) + { + w << " END DO\n"; + } + } + else + { + // intrinsic data types + // do all dimensions of arrays (no need for loop over i%d) + auto indent = " " + mainIndent; + + for (int d = field.rank; d >= 1; d--) + { + w << indent << " DO i" << d << " = LBOUND(InData%" << field.name << "," << d + << "), UBOUND(InData%" << field.name << "," << d << ")\n"; + indent += " "; + } + + if (field.data_type->tag == DataType::Tag::Real) + { + if (field.data_type->basic.bit_size == 64) + { + w << indent << " DbKiBuf(Db_Xferred) = InData%" << field_dims << "\n"; + w << indent << " Db_Xferred = Db_Xferred + 1\n"; + } + else + { + w << indent << " ReKiBuf(Re_Xferred) = InData%" << field_dims << "\n"; + w << indent << " Re_Xferred = Re_Xferred + 1\n"; + } + } + else if (field.data_type->tag == DataType::Tag::Integer) + { + w << indent << " IntKiBuf(Int_Xferred) = InData%" << field_dims << "\n"; + w << indent << " Int_Xferred = Int_Xferred + 1\n"; + } + else if (field.data_type->tag == DataType::Tag::Logical) + { + w << indent << " IntKiBuf(Int_Xferred) = TRANSFER(InData%" << field_dims + << ", IntKiBuf(1))\n"; + w << indent << " Int_Xferred = Int_Xferred + 1\n"; + } + else if (field.data_type->tag == DataType::Tag::Character) + { + w << indent << " DO I = 1, LEN(InData%" << field.name << ")\n"; + w << indent << " IntKiBuf(Int_Xferred) = ICHAR(InData%" << field_dims + << "(I:I), IntKi)\n"; + w << indent << " Int_Xferred = Int_Xferred + 1\n"; + w << indent << " END DO ! I\n"; + } + + for (int d = field.rank; d >= 1; d--) + { + indent = " " + mainIndent; + for (int i = 1; i < d; i++) + indent += " "; + w << indent << " END DO\n"; + } + } + + if (field.is_allocatable) + w << " END IF\n"; + } + + w << " END SUBROUTINE " << routine_name << "\n\n"; +} + +void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, bool gen_c_code) +{ + auto routine_name = mod.nickname + "_UnPack" + ddt.name_short; + + w << " SUBROUTINE " << routine_name + << "( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg )\n"; + w << " REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:)\n"; + w << " REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:)\n"; + w << " INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:)\n"; + w << " TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: OutData\n"; + w << " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n"; + w << " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"; + w << " ! Local variables\n"; + w << " INTEGER(IntKi) :: Buf_size\n"; + w << " INTEGER(IntKi) :: Re_Xferred\n"; + w << " INTEGER(IntKi) :: Db_Xferred\n"; + w << " INTEGER(IntKi) :: Int_Xferred\n"; + w << " INTEGER(IntKi) :: i\n"; + for (int d = 1; d <= ddt.max_rank; d++) + { + w << " INTEGER(IntKi) :: i" << d << ", i" << d << "_l, i" << d + << "_u ! bounds (upper/lower) for an array dimension " << d << "\n"; + } + w << " INTEGER(IntKi) :: ErrStat2\n"; + w << " CHARACTER(ErrMsgLen) :: ErrMsg2\n"; + w << " CHARACTER(*), PARAMETER :: RoutineName = '" << routine_name << "'\n"; + + w << " ! buffers to store meshes, if any\n"; + w << " REAL(ReKi), ALLOCATABLE :: Re_Buf(:)\n"; + w << " REAL(DbKi), ALLOCATABLE :: Db_Buf(:)\n"; + w << " INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:)\n"; + w << " !\n"; + w << " ErrStat = ErrID_None\n"; + w << " ErrMsg = \"\"\n"; + w << " Re_Xferred = 1\n"; + w << " Db_Xferred = 1\n"; + w << " Int_Xferred = 1\n"; + + // BJJ: TODO: if there are C types, we're going to have to associate with C data structures.... + + // Loop through fields and generate code to unpack data + for (auto &field : ddt.fields) + { + std::string mainIndent; + auto field_dims = field.name + dimstr(field.rank); + std::string var = "OutData%" + field.name; + std::string var_dims = "OutData%" + field.name + dimstr(field.rank); + std::string var_c = "OutData%C_obj%" + field.name; + + // Nullify non-target pointer fields and continue + if (field.is_pointer && !field.is_target) + { + w << " NULLIFY(" << var << ")\n"; + continue; + } + + if (field.is_allocatable) + { + auto assoc_alloc = field.is_pointer ? "ASSOCIATED" : "ALLOCATED"; + + // determine if the array was allocated when packed: + w << " IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! " << field.name + << " not allocated\n"; + w << " Int_Xferred = Int_Xferred + 1\n"; + w << " ELSE\n"; + w << " Int_Xferred = Int_Xferred + 1\n"; + + std::string dims; + for (int d = 1; d <= field.rank; d++) + { + w << " i" << d << "_l = IntKiBuf( Int_Xferred )\n"; + w << " i" << d << "_u = IntKiBuf( Int_Xferred + 1)\n"; + w << " Int_Xferred = Int_Xferred + 2\n"; + dims += (d == 1 ? "(i" : "i") + std::to_string(d) + "_l:i" + + std::to_string(d) + "_u" + (d == field.rank ? ")" : ","); + } + + w << " IF (" << assoc_alloc << "(" << var << ")) DEALLOCATE(" << var << ")\n"; + w << " ALLOCATE(" << var << dims << ",STAT=ErrStat2)\n"; + w << " IF (ErrStat2 /= 0) THEN \n"; + w << " CALL SetErrStat(ErrID_Fatal, 'Error allocating " << var + << ".', ErrStat, ErrMsg,RoutineName)\n"; + w << " RETURN\n"; + w << " END IF\n"; + + // bjj: this needs to be updated if we've got multiple dimension arrays + if (gen_c_code && field.is_pointer) + { + w << " " << var_c << "_Len = SIZE(" << var << ")\n"; + w << " IF (" << var_c << "_Len > 0) &\n"; + w << " " << var_c << " = C_LOC( " << var << "("; + for (int d = 1; d <= field.rank; d++) + w << (d > 1 ? "," : "") << " i" << d << "_l"; + w << " ) )\n"; + } + mainIndent = " "; + } + else + { + for (int d = 1; d <= field.rank; d++) + { + w << " i" << d << "_l = LBOUND(" << var << "," << d << ")\n"; + w << " i" << d << "_u = UBOUND(" << var << "," << d << ")\n"; + } + mainIndent = ""; + } + + // Call individual routines to pack data from subtypes: + if (field.data_type->tag == DataType::Tag::Derived) + { + for (int d = field.rank; d >= 1; d--) + { + w << " DO i" << d << " = LBOUND(" << var << "," << d << "), UBOUND(" << var + << "," << d << ")\n"; + } + + // initialize buffers to send to subtype-unpack routines: + + // reals: + w << " Buf_size=IntKiBuf( Int_Xferred )\n"; + w << " Int_Xferred = Int_Xferred + 1\n"; + w << " IF(Buf_size > 0) THEN\n"; + w << " ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2)\n"; + w << " IF (ErrStat2 /= 0) THEN \n"; + w << " CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName)\n"; + w << " RETURN\n"; + w << " END IF\n"; + w << " Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 )\n"; + w << " Re_Xferred = Re_Xferred + Buf_size\n"; + w << " END IF\n"; + + // doubles: + w << " Buf_size=IntKiBuf( Int_Xferred )\n"; + w << " Int_Xferred = Int_Xferred + 1\n"; + w << " IF(Buf_size > 0) THEN\n"; + w << " ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2)\n"; + w << " IF (ErrStat2 /= 0) THEN \n"; + w << " CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName)\n"; + w << " RETURN\n"; + w << " END IF\n"; + w << " Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 )\n"; + w << " Db_Xferred = Db_Xferred + Buf_size\n"; + w << " END IF\n"; + + // integers: + w << " Buf_size=IntKiBuf( Int_Xferred )\n"; + w << " Int_Xferred = Int_Xferred + 1\n"; + w << " IF(Buf_size > 0) THEN\n"; + w << " ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2)\n"; + w << " IF (ErrStat2 /= 0) THEN \n"; + w << " CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName)\n"; + w << " RETURN\n"; + w << " END IF\n"; + w << " Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 )\n"; + w << " Int_Xferred = Int_Xferred + Buf_size\n"; + w << " END IF\n"; + + if (field.data_type->derived.name.compare("MeshType") == 0) + { + w << " CALL MeshUnpack( " << var_dims + << ", Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! " << field.name << " \n"; + } + else if (field.data_type->derived.name.compare("DLL_Type") == 0) + { + w << " CALL DLLTypeUnpack( " << var_dims + << ", Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! " << field.name << " \n"; + } + else + { + w << " CALL " << field.data_type->derived.module->nickname << "_Unpack" + << field.data_type->derived.name_short << "( Re_Buf, Db_Buf, Int_Buf, " << var_dims + << ", ErrStat2, ErrMsg2 ) ! " << field.name << " \n"; + } + w << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"; + w << " IF (ErrStat >= AbortErrLev) RETURN\n\n"; + w << " IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf )\n"; + w << " IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf )\n"; + w << " IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf)\n"; + + for (int d = field.rank; d >= 1; d--) + w << " END DO\n"; + } + else + { + auto indent = " " + mainIndent; + for (int d = field.rank; d >= 1; d--) + { + w << indent << " DO i" << d << " = LBOUND(" << var << "," << d + << "), UBOUND(OutData%" << field.name << "," << d << ")\n"; + indent += " "; + } + + if (field.data_type->tag == DataType::Tag::Real && + field.data_type->basic.bit_size <= 32) + { + if (gen_c_code && field.is_pointer) + { + w << indent << " " << var_dims << " = REAL(ReKiBuf(Re_Xferred), C_FLOAT)\n"; + } + else if (field.data_type->basic.bit_size == 32) + { + w << indent << " " << var_dims << " = REAL(ReKiBuf(Re_Xferred), SiKi)\n"; + } + else + { + w << indent << " " << var_dims << " = ReKiBuf(Re_Xferred)\n"; + } + w << indent << " Re_Xferred = Re_Xferred + 1\n"; + } + else if (field.data_type->tag == DataType::Tag::Real && + field.data_type->basic.bit_size == 64) + { + if (gen_c_code && field.is_pointer) + { + w << indent << " " << var_dims << " = REAL(DbKiBuf(Db_Xferred), C_DOUBLE)\n"; + } + else if (field.data_type->basic.type_fortran.compare("REAL(R8Ki)") == 0) + { + w << indent << " " << var_dims << " = REAL(DbKiBuf(Db_Xferred), R8Ki)\n"; + } + else + { + w << indent << " " << var_dims << " = DbKiBuf(Db_Xferred)\n"; + } + w << indent << " Db_Xferred = Db_Xferred + 1\n"; + } + else if (field.data_type->tag == DataType::Tag::Integer) + { + w << indent << " " << var_dims << " = IntKiBuf(Int_Xferred)\n"; + w << indent << " Int_Xferred = Int_Xferred + 1\n"; + } + else if (field.data_type->tag == DataType::Tag::Logical) + { + w << indent << " " << var_dims << " = TRANSFER(IntKiBuf(Int_Xferred), OutData%" + << field_dims << ")\n"; + w << indent << " Int_Xferred = Int_Xferred + 1\n"; + } + else if (field.data_type->tag == DataType::Tag::Character) + { + + w << indent << " DO I = 1, LEN(" << var << ")\n"; + w << indent << " " << var_dims << "(I:I) = CHAR(IntKiBuf(Int_Xferred))\n"; + w << indent << " Int_Xferred = Int_Xferred + 1\n"; + w << indent << " END DO ! I\n"; + } + + for (int d = field.rank; d >= 1; d--) + { + indent = " " + mainIndent; + for (int i = 1; i < d; i++) + indent += " "; + w << indent << " END DO\n"; + } + + // need to move scalars and strings to the %c_obj% type, too! + // compare with copy routine + if (gen_c_code && !field.is_pointer && field.rank == 0) + { + std::string var_c = "OutData%C_obj%" + field.name; + switch (field.data_type->tag) + { + case DataType::Tag::Real: + case DataType::Tag::Integer: + case DataType::Tag::Logical: + w << " " << var_c << " = " << var << "\n"; + break; + case DataType::Tag::Character: + w << " " << var_c << " = TRANSFER(" << var << ", " << var_c << " )\n"; + break; + case DataType::Tag::Derived: + break; + } + } + } + + if (field.is_allocatable) + w << " END IF\n"; + } + + w << " END SUBROUTINE " << routine_name << "\n\n"; +} + +void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const int order, + const Field &field, const std::string &deref, int recurse_level) +{ + std::string indent, tmp; + + if (recurse_level > MAXRECURSE) + { + std::cerr << "REGISTRY ERROR: too many levels of array subtypes\n"; + exit(EXIT_FAILURE); + } + + auto assoc_alloc = field.is_pointer ? "ASSOCIATED" : "ALLOCATED"; + + std::string dims = dimstr(field.rank); + std::string v1 = uy + "1" + deref + "%" + field.name; + std::string v2 = uy + "2" + deref + "%" + field.name; + std::string v3 = uy + "3" + deref + "%" + field.name; + std::string vout = uy + "_out" + deref + "%" + field.name; + + // check if this is an allocatable array: + if (field.is_allocatable) + { + w << "IF (" << assoc_alloc << "(" << vout << ") .AND. " << assoc_alloc << "(" << v1 + << ")) THEN\n"; + } + + if (field.data_type->tag == DataType::Tag::Derived) + { + auto &ddt = field.data_type->derived; + + // If this is a type within this module + if ((ddt.module != nullptr) && (ddt.module->name == mod.name)) + { + for (auto &sub_field : ddt.fields) + { + std::string field_var = deref + "%" + field.name; + + for (int j = field.rank; j > 0; j--) + { + w << " DO i" << recurse_level << j << " = LBOUND(" << uy << "_out" << field_var + << "," << j << "),UBOUND(" << uy << "_out" << field_var << "," << j << ")\n"; + } + + if (field.rank > 0) + { + field_var += "("; + for (int j = 1; j <= field.rank; j++) + { + field_var += "i" + std::to_string(recurse_level) + std::to_string(j); + if (j < field.rank) + { + field_var += ","; + } + } + field_var += ")"; + } + + gen_extint_order(w, mod, uy, order, sub_field, field_var, recurse_level + 1); + for (int j = field.rank; j > 0; j--) + { + w << " ENDDO\n"; + } + } + } + else + { + for (int j = field.rank; j > 0; j--) + { + w << " DO i" << j << " = LBOUND(" << vout << "," << j << "),UBOUND(" << vout << "," + << j << ")\n"; + } + + if (field.data_type->derived.name.compare("MeshType") == 0) + { + if (order == 0) + { + w << " CALL MeshCopy(" << v1 + dims << ", " << vout + dims + << ", MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n"; + } + else if (order == 1) + { + w << " CALL MeshExtrapInterp1(" << v1 + dims << ", " << v2 + dims + << ", tin, " << vout + dims << ", tin_out, ErrStat2, ErrMsg2 )\n"; + } + else if (order == 2) + { + w << " CALL MeshExtrapInterp2(" << v1 + dims << ", " << v2 + dims << ", " + << v3 + dims << ", tin, " << vout + dims + << ", tin_out, ErrStat2, ErrMsg2 )\n"; + } + } + else + { + if (order == 0) + { + w << " CALL " << field.data_type->derived.module->nickname << "_Copy" + << field.data_type->derived.name_short << "(" << v1 + dims << ", " + << vout + dims << ", MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n"; + } + else if (order == 1) + { + w << " CALL " << field.data_type->derived.module->nickname << "_" + << field.data_type->derived.name_short << "_ExtrapInterp1( " << v1 + dims + << ", " << v2 + dims << ", tin, " << vout + dims + << ", tin_out, ErrStat2, ErrMsg2 )\n"; + } + else if (order == 2) + { + w << " CALL " << field.data_type->derived.module->nickname << "_" + << field.data_type->derived.name_short << "_ExtrapInterp2( " << v1 + dims + << ", " << v2 + dims << ", " << v3 + dims << ", tin, " << vout + dims + << ", tin_out, ErrStat2, ErrMsg2 )\n"; + } + } + + w << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"; + + for (int j = field.rank; j >= 1; j--) + { + w << " ENDDO\n"; + } + } + } + else if (field.data_type->tag == DataType::Tag::Real) + { + if (order == 0) + { + // bjj: this should probably have some "IF ALLOCATED" statements around it, but we're + // just calling the copy routine + w << " " << vout << " = " << v1 << "\n"; + } + else + { + indent = ""; + } + + for (int j = field.rank; j > 0; j--) + { + w << indent << " DO i" << j << " = LBOUND(" << vout << "," << j << "),UBOUND(" << vout + << "," << j << ")\n"; + indent += " "; + } + + if (order == 1) + { + if (field.gen_periodic == Period::TwoPi) + { + w << indent << " CALL Angles_ExtrapInterp( " << v1 + dims << ", " << v2 + dims + << ", tin, " << vout + dims << ", tin_out )\n"; + } + else + { + w << indent << " b = -(" << v1 + dims << " - " << v2 + dims << ")\n"; + w << indent << " " << vout + dims << " = " << v1 + dims << " + b * ScaleFactor\n"; + }; + } + if (order == 2) + { + if (field.gen_periodic == Period::TwoPi) + { + w << indent << " CALL Angles_ExtrapInterp( " << v1 + dims << ", " << v2 + dims + << ", " << v3 + dims << ", tin, " << vout + dims << ", tin_out )\n"; + } + else + { + w << indent << " b = (t(3)**2*(" << v1 + dims << " - " << v2 + dims + << ") + t(2)**2*(-" << v1 + dims << " + " << v3 + dims << "))* scaleFactor\n "; + w << indent << " c = ( (t(2)-t(3))*" << v1 + dims << " + t(3)*" << v2 + dims + << " - t(2)*" << v3 + dims << " ) * scaleFactor\n"; + w << indent << " " << vout + dims << " = " << v1 + dims << " + b + c * t_out\n"; + } + } + for (int j = field.rank; j >= 1; j--) + { + indent = ""; + for (int i = 1; i < j; i++) + indent += " "; + w << indent << " END DO\n"; + } + } + + // check if this is an allocatable array: + if (field.is_allocatable) + w << "END IF ! check if allocated\n"; +} + +void calc_extint_order(std::ostream &w, const Module &mod, const Field &field, int recurse_level, + int &max_rank, int &max_nrecurs, int &max_alloc_ndims) +{ + // bjj: make sure this is consistent with logic of gen_extint_order + + // If recursion level is greater than limit, exit with error + if (recurse_level > MAXRECURSE) + { + std::cerr << "REGISTRY ERROR: too many levels of array subtypes\n"; + exit(EXIT_FAILURE); + } + + // Update max dims based on field rank + max_rank = std::max(max_rank, field.rank); + + // Switch based on field data type + switch (field.data_type->tag) + { + case DataType::Tag::Derived: + + // If this derived type belongs to this module + if (field.data_type->derived.module != nullptr && + field.data_type->derived.module->name.compare(mod.name) == 0) + { + // Update recursion level + max_nrecurs = std::max(max_nrecurs, recurse_level); + + // Loop through fields and calculate order + for (const auto &sub_field : field.data_type->derived.fields) + calc_extint_order(w, mod, sub_field, recurse_level + 1, max_rank, max_nrecurs, + max_alloc_ndims); + } + break; + + case DataType::Tag::Real: + max_alloc_ndims = std::max(max_alloc_ndims, field.rank); + break; + + default: + // TODO: handle other field types + break; + } +} + +void gen_ExtrapInterp1(std::ostream &w, const Module &mod, const DataType::Derived &ddt, + std::string &type_kind, std::string &uy, std::string &mod_prefix, + const int max_rank, const int max_nrecurs, const int max_alloc_ndims) +{ + w << "\n"; + w << " SUBROUTINE " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp1(" << uy << "1, " + << uy << "2, tin, " << uy << "_out, tin_out, ErrStat, ErrMsg )\n"; + w << "!\n"; + w << "! This subroutine calculates a extrapolated (or interpolated) " << ddt.name_short << " " + << uy << "_out at time t_out, from previous/future time\n"; + w << "! values of " << uy + << " (which has values associated with times in t). Order of the interpolation is 1.\n"; + w << "!\n"; + w << "! f(t) = a + b * t, or\n"; + w << "!\n"; + w << "! where a and b are determined as the solution to\n"; + w << "! f(t1) = " << uy << "1, f(t2) = " << uy << "2\n"; + w << "!\n"; + w << "!" << std::string(130, '.') << "\n"; + w << "\n"; + + w << " TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh == 1 ? "INOUT" : "IN") + << ") :: " << uy << "1 ! " << ddt.name_short << " at t1 > t2\n"; + w << " TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh == 1 ? "INOUT" : "IN") + << ") :: " << uy << "2 ! " << ddt.name_short << " at t2 \n"; + w << " REAL(" << type_kind + << "), INTENT(IN ) :: tin(2) ! Times associated with the " + << ddt.name_short << "s\n"; + w << " TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << uy << "_out ! " + << ddt.name_short << " at tin_out\n"; + w << " REAL(" << type_kind + << "), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to\n"; + w << " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n"; + w << " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n"; + w << " ! local variables\n"; + w << " REAL(" << type_kind + << ") :: t(2) ! Times associated with the " + << ddt.name_short << "s\n"; + w << " REAL(" << type_kind + << ") :: t_out ! Time to which to be extrap/interpd\n"; + w << " CHARACTER(*), PARAMETER :: RoutineName = '" << mod.nickname << "_" + << ddt.name_short << "_ExtrapInterp1'\n"; + + w << " REAL(DbKi) :: b ! temporary for extrapolation/interpolation\n"; + w << " REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation\n"; + w << " INTEGER(IntKi) :: ErrStat2 ! local errors\n"; + w << " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"; + for (int j = 1; j <= max_rank; j++) + { + for (int i = 0; i <= max_nrecurs; i++) + { + w << " INTEGER :: i" << i << j << " ! dim" << j + << " level " << i << " counter variable for arrays of ddts\n"; + } + } + for (int j = 1; j <= max_rank; j++) + { + w << " INTEGER :: i" << j << " ! dim" << j + << " counter variable for arrays\n"; + } + w << " ! Initialize ErrStat\n"; + w << " ErrStat = ErrID_None\n"; + w << " ErrMsg = \"\"\n"; + w << " ! we'll subtract a constant from the times to resolve some \n"; + w << " ! numerical issues when t gets large (and to simplify the equations)\n"; + w << " t = tin - tin(1)\n"; + w << " t_out = tin_out - tin(1)\n"; + w << "\n"; + + w << " IF ( EqualRealNos( t(1), t(2) ) ) THEN\n"; + w << " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"; + w << " RETURN\n"; + w << " END IF\n\n"; + + w << " ScaleFactor = t_out / t(2)" << std::endl; + + for (const auto &field : ddt.fields) + gen_extint_order(w, mod, uy, 1, field, "", 0); + + w << " END SUBROUTINE " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp1\n"; + w << "\n"; +} + +void gen_ExtrapInterp2(std::ostream &w, const Module &mod, const DataType::Derived &ddt, + std::string &type_kind, std::string &uy, std::string &modPrefix, + const int max_rank, const int max_nrecurs, const int max_alloc_ndims) +{ + w << "\n"; + w << " SUBROUTINE " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp2(" << uy << "1, " + << uy << "2, " << uy << "3, tin, " << uy << "_out, tin_out, ErrStat, ErrMsg )\n"; + w << "!\n"; + w << "! This subroutine calculates a extrapolated (or interpolated) " << ddt.name_short << " " + << uy << "_out at time t_out, from previous/future time\n"; + w << "! values of " << uy + << " (which has values associated with times in t). Order of the interpolation is 2.\n"; + w << "!\n"; + w << "! expressions below based on either\n"; + w << "!\n"; + w << "! f(t) = a + b * t + c * t**2\n"; + w << "!\n"; + w << "! where a, b and c are determined as the solution to\n"; + w << "! f(t1) = " << uy << "1, f(t2) = " << uy << "2, f(t3) = " << uy << "3\n"; + w << "!\n"; + w << "!" << std::string(130, '.') << "\n"; + w << "\n"; + + w << " TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh == 1 ? "INOUT" : "IN") + << ") :: " << uy << "1 ! " << ddt.name_short << " at t1 > t2 > t3\n"; + w << " TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh == 1 ? "INOUT" : "IN") + << ") :: " << uy << "2 ! " << ddt.name_short << " at t2 > t3\n"; + w << " TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh == 1 ? "INOUT" : "IN") + << ") :: " << uy << "3 ! " << ddt.name_short << " at t3\n"; + w << " REAL(" << type_kind + << "), INTENT(IN ) :: tin(3) ! Times associated with the " + << ddt.name_short << "s\n"; + w << " TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << uy << "_out ! " + << ddt.name_short << " at tin_out\n"; + w << " REAL(" << type_kind + << "), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to\n"; + + w << " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n"; + w << " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n"; + w << " ! local variables\n"; + w << " REAL(" << type_kind + << ") :: t(3) ! Times associated with the " + << ddt.name_short << "s\n"; + w << " REAL(" << type_kind + << ") :: t_out ! Time to which to be extrap/interpd\n"; + w << " INTEGER(IntKi) :: order ! order of polynomial fit (max 2)\n"; + + w << " REAL(DbKi) :: b ! temporary for extrapolation/interpolation\n"; + w << " REAL(DbKi) :: c ! temporary for extrapolation/interpolation\n"; + w << " REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation\n"; + w << " INTEGER(IntKi) :: ErrStat2 ! local errors\n"; + w << " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"; + w << " CHARACTER(*), PARAMETER :: RoutineName = '" << mod.nickname << "_" + << ddt.name_short << "_ExtrapInterp2'\n"; + for (int j = 1; j <= max_rank; j++) + { + for (int i = 0; i <= max_nrecurs; i++) + { + w << " INTEGER :: i" << i << j << " ! dim" << j + << " level " << i << " counter variable for arrays of ddts\n"; + } + } + for (int j = 1; j <= max_rank; j++) + { + w << " INTEGER :: i" << j << " ! dim" << j + << " counter variable for arrays\n"; + } + w << " ! Initialize ErrStat\n"; + w << " ErrStat = ErrID_None\n"; + w << " ErrMsg = \"\"\n"; + w << " ! we'll subtract a constant from the times to resolve some \n"; + w << " ! numerical issues when t gets large (and to simplify the equations)\n"; + w << " t = tin - tin(1)\n"; + w << " t_out = tin_out - tin(1)\n"; + w << "\n"; + + w << " IF ( EqualRealNos( t(1), t(2) ) ) THEN\n"; + w << " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"; + w << " RETURN\n"; + w << " ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN\n"; + w << " CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"; + w << " RETURN\n"; + w << " ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN\n"; + w << " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"; + w << " RETURN\n"; + w << " END IF\n\n"; + + w << " ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3)))\n"; + + // recursive + for (const auto &field : ddt.fields) + { + gen_extint_order(w, mod, uy, 2, field, "", 0); + } + + w << " END SUBROUTINE " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp2\n"; + w << "\n"; +} + +void gen_ExtrapInterp(std::ostream &w, const Module &mod, std::string type_name_long, + std::string type_kind, const bool useModPrefix) +{ + // Get derived data type from module + std::string modPrefix = useModPrefix ? mod.nickname + "_" : ""; + auto iter = mod.data_types.find(modPrefix + type_name_long); + if (iter == mod.data_types.end()) + return; + const auto &dt = iter->second; + if (dt == nullptr) + return; + const auto &ddt = dt->derived; + + std::string uy = tolower(ddt.name_short).compare("output") == 0 ? "y" : "u"; + + w << "\n"; + w << " SUBROUTINE " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp(" << uy + << ", t, " << uy << "_out, t_out, ErrStat, ErrMsg )\n"; + w << "!\n"; + w << "! This subroutine calculates a extrapolated (or interpolated) " << ddt.name_short << " " + << uy << "_out at time t_out, from previous/future time\n"; + w << "! values of " << uy + << " (which has values associated with times in t). Order of the interpolation is given by the size of " + << uy << "\n"; + w << "!\n"; + w << "! expressions below based on either\n"; + w << "!\n"; + w << "! f(t) = a\n"; + w << "! f(t) = a + b * t, or\n"; + w << "! f(t) = a + b * t + c * t**2\n"; + w << "!\n"; + w << "! where a, b and c are determined as the solution to\n"; + w << "! f(t1) = " << uy << "1, f(t2) = " << uy << "2, f(t3) = " << uy + << "3 (as appropriate)\n"; + w << "!\n"; + w << "!" << std::string(130, '.') << "\n"; + w << "\n"; + w << " TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh == 1 ? "INOUT" : "IN") + << ") :: " << uy << "(:) ! " << ddt.name_short << " at t1 > t2 > t3\n"; + w << " REAL(" << type_kind + << "), INTENT(IN ) :: t(:) ! Times associated with the " + << ddt.name_short << "s\n"; + // Intent must be (INOUT) to prevent ALLOCATABLE array arguments in the DDT from + // being deallocated in this call. See Sec. 5.1.2.7 of Fortran 2003 standard + w << " TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << uy << "_out ! " + << ddt.name_short << " at tin_out\n"; + w << " REAL(" << type_kind + << "), INTENT(IN ) :: t_out ! time to be extrap/interp'd to\n"; + w << " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n"; + w << " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n"; + w << " ! local variables\n"; + w << " INTEGER(IntKi) :: order ! order of polynomial fit (max 2)\n"; + w << " INTEGER(IntKi) :: ErrStat2 ! local errors\n"; + w << " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"; + w << " CHARACTER(*), PARAMETER :: RoutineName = '" << mod.nickname << "_" + << ddt.name_short << "_ExtrapInterp'\n"; + w << " ! Initialize ErrStat\n"; + w << " ErrStat = ErrID_None\n"; + w << " ErrMsg = \"\"\n"; + w << " if ( size(t) .ne. size(" << uy << ")) then\n"; + w << " CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(" << uy + << ")',ErrStat,ErrMsg,RoutineName)\n"; + w << " RETURN\n"; + w << " endif\n"; + w << " order = SIZE(" << uy << ") - 1\n"; + w << " IF ( order .eq. 0 ) THEN\n"; + w << " CALL " << mod.nickname << "_Copy" << ddt.name_short << "(" << uy << "(1), " << uy + << "_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n"; + w << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"; + w << " ELSE IF ( order .eq. 1 ) THEN\n"; + w << " CALL " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp1(" << uy << "(1), " + << uy << "(2), t, " << uy << "_out, t_out, ErrStat2, ErrMsg2 )\n"; + w << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"; + w << " ELSE IF ( order .eq. 2 ) THEN\n"; + w << " CALL " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp2(" << uy << "(1), " + << uy << "(2), " << uy << "(3), t, " << uy << "_out, t_out, ErrStat2, ErrMsg2 )\n"; + w << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"; + w << " ELSE \n"; + w << " CALL SetErrStat(ErrID_Fatal,'size(" << uy + << ") must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName)\n"; + w << " RETURN\n"; + w << " ENDIF \n"; + w << " END SUBROUTINE " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp\n"; + w << "\n"; + + // bjj: this is max for module, not for type_name_long + int max_rank = 0; // mod.module_ddt_list->max_ndims; + int max_nrecurs = 0; // MAXRECURSE; + int max_alloc_ndims = 0; + + // Recursively calculate extrap/interp order + for (const auto &field : ddt.fields) + { + calc_extint_order(w, mod, field, 0, max_rank, max_nrecurs, max_alloc_ndims); + } + + // Generate first order extrap/interp routine + gen_ExtrapInterp1(w, mod, ddt, type_kind, uy, modPrefix, max_rank, max_nrecurs, + max_alloc_ndims); + + // Generate second order extrap/interp routine + gen_ExtrapInterp2(w, mod, ddt, type_kind, uy, modPrefix, max_rank, max_nrecurs, + max_alloc_ndims); +} + +void gen_copy_c2f(std::ostream &w, const Module &mod, const DataType::Derived &ddt) +{ + std::string routine_name = mod.nickname + "_C2Fary_Copy" + ddt.name_short; + + w << " SUBROUTINE " << routine_name << "( " << ddt.name_short + << "Data, ErrStat, ErrMsg, SkipPointers )\n"; + w << " TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << ddt.name_short << "Data\n"; + w << " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n"; + w << " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"; + w << " LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers\n"; + w << " ! \n"; + w << " LOGICAL :: SkipPointers_local\n"; + w << " ErrStat = ErrID_None\n"; + w << " ErrMsg = \"\"\n\n"; + w << " IF (PRESENT(SkipPointers)) THEN\n"; + w << " SkipPointers_local = SkipPointers\n"; + w << " ELSE\n"; + w << " SkipPointers_local = .false.\n"; + w << " END IF\n"; + + // Loop through fields in derived data type + for (const auto &field : ddt.fields) + { + // If field doesn't have a data type, continue + if (field.data_type == nullptr) + { + continue; + } + + // If field is a derived type, print warning and continue + if (field.data_type->tag == DataType::Tag::Derived) + { + std::cerr << "Registry WARNING: derived data type " << field.name << " of type " + << field.data_type->derived.name << " is not passed through C interface\n"; + continue; + } + + std::string var_f = ddt.name_short + "Data%" + field.name; + std::string var_c = ddt.name_short + "Data%C_obj%" + field.name; + if (field.is_pointer) + { + w << "\n ! -- " << field.name << " " << ddt.name_short << " Data fields\n"; + w << " IF ( .NOT. SkipPointers_local ) THEN\n"; + w << " IF ( .NOT. C_ASSOCIATED( " << var_c << " ) ) THEN\n"; + w << " NULLIFY( " << var_f << " )\n"; + w << " ELSE\n"; + w << " CALL C_F_POINTER(" << var_c << ", " << var_f << ", (/" << var_c + << "_Len/))\n"; + w << " END IF\n"; + w << " END IF\n"; + } + else if (!field.is_allocatable) + { + switch (field.data_type->tag) + { + case DataType::Tag::Real: + case DataType::Tag::Integer: + case DataType::Tag::Logical: + w << " " << var_f << " = " << var_c << "\n"; + break; + case DataType::Tag::Character: + if (field.rank == 0) + w << " " << var_f << " = TRANSFER(" << var_c << ", " << var_f << " )\n"; + break; + case DataType::Tag::Derived: + break; + } + } + } + + w << " END SUBROUTINE " << routine_name << "\n\n"; +} + +void gen_copy_f2c(std::ostream &w, const Module &mod, const DataType::Derived &ddt) +{ + std::string routine_name = mod.nickname + "_F2C_Copy" + ddt.name_short; + + w << " SUBROUTINE " << routine_name << "( " << ddt.name_short + << "Data, ErrStat, ErrMsg, SkipPointers )\n"; + w << " TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << ddt.name_short << "Data\n"; + w << " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n"; + w << " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"; + w << " LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers\n"; + w << " ! \n"; + w << " LOGICAL :: SkipPointers_local\n"; + w << " ErrStat = ErrID_None\n"; + w << " ErrMsg = \"\"\n\n"; + w << " IF (PRESENT(SkipPointers)) THEN\n"; + w << " SkipPointers_local = SkipPointers\n"; + w << " ELSE\n"; + w << " SkipPointers_local = .false.\n"; + w << " END IF\n"; + + for (const auto &field : ddt.fields) + { + + // If field doesn't have a data type, continue + if (field.data_type == nullptr) + { + continue; + } + + // If field is a derived type, print warning and continue + if (field.data_type->tag == DataType::Tag::Derived) + { + std::cerr << "Registry WARNING: derived data type " << field.name << " of type " + << field.data_type->derived.name << " is not passed through F-C interface\n"; + continue; + } + + std::string var_f = ddt.name_short + "Data%" + field.name; + std::string var_c = ddt.name_short + "Data%C_obj%" + field.name; + + if (field.is_pointer) + { + w << "\n ! -- " << field.name << " " << ddt.name_short << " Data fields\n"; + w << " IF ( .NOT. SkipPointers_local ) THEN\n"; + w << " IF ( .NOT. ASSOCIATED(" << var_f << ")) THEN \n"; + w << " " << var_c << "_Len = 0\n"; + w << " " << var_c << " = C_NULL_PTR\n"; + w << " ELSE\n"; + w << " " << var_c << "_Len = SIZE(" << var_f << ")\n"; + w << " IF (" << var_c << "_Len > 0) &\n"; + w << " " << var_c << " = C_LOC( " << var_f << "("; + for (int d = 1; d <= field.rank; d++) + { + w << (d > 1 ? "," : "") << " LBOUND(" << var_f << "," << d << ")"; + } + w << " ) )\n"; + w << " END IF\n"; + w << " END IF\n"; + } + else if (!field.is_allocatable) + { + + switch (field.data_type->tag) + { + case DataType::Tag::Real: + case DataType::Tag::Integer: + case DataType::Tag::Logical: + w << " " << var_c << " = " << var_f << "\n"; + break; + case DataType::Tag::Character: + if (field.rank == 0) + w << " " << var_c << " = TRANSFER(" << var_f << ", " << var_c << " )\n"; + break; + case DataType::Tag::Derived: + break; + } + } + } + + w << " END SUBROUTINE " << routine_name << "\n\n"; +} \ No newline at end of file diff --git a/modules/openfast-registry/src/registry_parse.cpp b/modules/openfast-registry/src/registry_parse.cpp new file mode 100644 index 0000000000..e8ad7cdaf9 --- /dev/null +++ b/modules/openfast-registry/src/registry_parse.cpp @@ -0,0 +1,293 @@ +#include +#include + +#include "registry.hpp" + +const int MAX_FIELDS = 10; + +void Registry::parse(const std::string &file_name, const int recurse_level) +{ + std::ifstream inp_file; + std::vector fields_prev; + + // If this is the root file, open given file name + if (recurse_level == 0) + { + std::cerr << "input file: " << file_name << std::endl; + inp_file.open(file_name); + if (!inp_file) + { + std::cerr << "Registry program cannot open " << file_name << " for reading. "; + std::cerr << "Ending." << std::endl; + exit(EXIT_FAILURE); + } + } + // Otherwise, find and open include file + else + { + // If this include file has been parsed, return + if (this->include_files.find(file_name) != this->include_files.end()) + return; + + // Loop through directories and try to open file, break on success + for (auto &dir : this->include_dirs) + { + inp_file.open(dir + "/" + file_name); + if (inp_file) + break; + } + + // If file not opened successfully, exit + if (!inp_file) + { + std::cerr << "Registry error: cannot open '" << file_name << "'." << std::endl; + exit(EXIT_FAILURE); + } + + // Display message about opening file + std::cerr << "opening " << file_name << std::endl; + + // Add file to list of includes + this->include_files.insert(file_name); + } + + // Loop through lines in file and parse + std::string line; + for (size_t line_num = 1; std::getline(inp_file, line); ++line_num) + { + // Parse line into record + if (this->parse_line(line, fields_prev, recurse_level) != 0) + { + std::cerr << "Error reading " << file_name << ":" << line_num << "\n"; + exit(EXIT_FAILURE); + } + } + + // If this file is directly included by the root file, save use module + if (recurse_level == 1) + { + auto slash_index = fields_prev[1].find("/"); + bool has_slash = slash_index != std::string::npos; + auto module_name = has_slash ? fields_prev[1].substr(0, slash_index) : fields_prev[1]; + this->use_modules.push_back(module_name); + } +} + +int Registry::parse_line(const std::string &line, std::vector &fields_prev, + const int recurse_level) +{ + std::istringstream iss(line); + std::string s; + std::vector fields; + + // Read fields from line while respecting quotes + while (iss >> std::quoted(s)) + { + // If # found in unquoted field, break iteration + if (s.find("#") != std::string::npos && s.find(" ") == std::string::npos) + break; + + fields.push_back(s); + } + + // Skip empty line + if (fields.size() == 0 || fields[0][0] == '#') + return EXIT_SUCCESS; + + //-------------------------------------------------------------------------- + // Include Line + //-------------------------------------------------------------------------- + + if (fields.size() == 2 && + (tolower(fields[0]).compare("include") == 0 || tolower(fields[0]).compare("usefrom") == 0)) + { + auto file_name = fields[1]; + this->parse(file_name, recurse_level + 1); + return EXIT_SUCCESS; + } + + //-------------------------------------------------------------------------- + // Populate Fields + //-------------------------------------------------------------------------- + + // Resize and fill remaining fields + fields.resize(MAX_FIELDS, "-"); + + // Propagate field values from previous fields if requested + for (int i = 0; i < MAX_FIELDS; i++) + if (fields[i].compare("^") == 0) + fields[i] = fields_prev[i]; + + // Update previous fields to current values + fields_prev = fields; + + //-------------------------------------------------------------------------- + // Get Module + //-------------------------------------------------------------------------- + + // Shared pointer to module + std::shared_ptr mod; + + // Is this the root module + auto is_root = recurse_level == 0; + + // Parse module name and nickname from field + auto slash_index = fields[1].find("/"); + bool has_slash = slash_index != std::string::npos; + auto module_name = has_slash ? fields[1].substr(0, slash_index) : fields[1]; + auto module_nickname = has_slash ? fields[1].substr(slash_index + 1) : fields[1]; + + // Find module in map or create and add it to map + auto it = this->modules.find(module_name); + if (it == this->modules.end()) + { + mod = std::make_shared(module_name, module_nickname, is_root); + this->modules[module_name] = mod; + } + else + { + mod = it->second; + } + + //-------------------------------------------------------------------------- + // Parameter Line + //-------------------------------------------------------------------------- + + if (tolower(fields[0]).compare("param") == 0) + { + auto name = fields[4]; + auto type = fields[3]; + auto value = fields[6]; + auto desc = fields[8]; + auto units = fields[9]; + + // Find parameter type in registry, display message if not found + auto param_type = this->find_data_type(type); + if (param_type == nullptr) + { + std::cerr << "Registry error: type " << type << " used before defined for " << name + << std::endl; + return EXIT_FAILURE; + } + + // Add parameter to module + mod->params.push_back(Parameter(name, param_type, value, desc, units)); + return EXIT_SUCCESS; + } + + //-------------------------------------------------------------------------- + // Derived Type Line + //-------------------------------------------------------------------------- + + if ((tolower(fields[0]).compare("typedef") == 0) || + (tolower(fields[0]).compare("usefrom") == 0)) + { + auto ddt_name_base = fields[2]; + auto field_type_name = fields[3]; + auto name = fields[4]; + auto dims = fields[5]; + auto init_value = fields[6]; + auto ctrl = fields[7]; + auto desc = fields[8]; + auto units = fields[9]; + + // Get derived data type name + auto ddt_name = ddt_name_base; + auto ddt_name_short = ddt_name_base; + + // Remove module prefix from name + std::string prefix = tolower(mod->nickname) + "_"; + if (tolower(ddt_name_short).compare(0, prefix.size(), prefix) == 0) + { + ddt_name_short = ddt_name_short.substr(prefix.size()); + } + + // If interface name was found for derived data type, prepend module nickname + auto it = this->interface_map.find(ddt_name_short); + auto is_interface_type = it != this->interface_map.end(); + if (is_interface_type) + { + ddt_name = mod->nickname + "_" + ddt_name_short; + } + + // Get data type from module + auto ddt_dt = this->find_data_type(ddt_name, mod); + + // If struct type not found and module is not root, get from registry + if (ddt_dt == nullptr && !mod->is_root) + ddt_dt = this->find_data_type(ddt_name); + + // If derived data type not found, create and add to module or registry + if (ddt_dt == nullptr) + { + // Get short name from interface if this is an interface type + if (is_interface_type) + ddt_name_short = it->second->name_short; + + // Create derived data type + ddt_dt = std::make_shared(mod, ddt_name_base, ddt_name_short, ddt_name); + + // Add interface to type if found + if (is_interface_type) + ddt_dt->derived.interface = it->second; + + // Add type module if this is root; otherwise, add to registry + if (is_root) + { + mod->data_types[ddt_name] = ddt_dt; + mod->ddt_names.push_back(ddt_name); + } + else + { + this->data_types[ddt_name] = ddt_dt; + } + } + + // Get field data type from module or registry + auto field_dt = this->find_data_type(field_type_name, mod); + if (field_dt == nullptr) + { + field_dt = this->find_data_type(field_type_name); + } + if (field_dt == nullptr) + { + std::cerr << "Error: type " << field_type_name << " used before defined for " << name + << std::endl; + return EXIT_FAILURE; + } + + // Create field + Field field(name, field_dt, dims, ctrl, init_value, desc, units); + + // The field is a target pointer if the following is true: + // - C code will be generated + // - The field is allocatable + // - The field is not a derived type + // - The field name doesn't start with "writeoutput" + if (this->gen_c_code && field.is_allocatable && + (field.data_type->tag != DataType::Tag::Derived) && + (tolower(field.name.substr(0, 11)).compare("writeoutput") != 0)) + { + field.is_pointer = true; + field.is_target = true; + } + + // If field is a mesh derived type (MeshType or MeshMapType) + // or a derived type that contains a mesh, + // set flag in derived data type + if ((field.data_type->tag == DataType::Tag::Derived) && + field.data_type->derived.contains_mesh) + ddt_dt->derived.contains_mesh = true; + + // Accumulate max rank of fields in derived data type + ddt_dt->derived.max_rank = std::max(ddt_dt->derived.max_rank, field.rank); + + // Add field to derived data type + ddt_dt->derived.fields.push_back(field); + return EXIT_SUCCESS; + } + + // Line is invalid + std::cerr << "Error: invalid line: '" << line << "'\n"; + return EXIT_FAILURE; +} diff --git a/modules/openfast-registry/src/sym.c b/modules/openfast-registry/src/sym.c deleted file mode 100644 index 689f5800ba..0000000000 --- a/modules/openfast-registry/src/sym.c +++ /dev/null @@ -1,163 +0,0 @@ -/*********************************************************************** - - COPYRIGHT - - The following is a notice of limited availability of the code and - Government license and disclaimer which must be included in the - prologue of the code and in all source listings of the code. - - Copyright notice - (c) 1977 University of Chicago - - Permission is hereby granted to use, reproduce, prepare - derivative works, and to redistribute to others at no charge. If - you distribute a copy or copies of the Software, or you modify a - copy or copies of the Software or any portion of it, thus forming - a work based on the Software and make and/or distribute copies of - such work, you must meet the following conditions: - - a) If you make a copy of the Software (modified or verbatim) - it must include the copyright notice and Government - license and disclaimer. - - b) You must cause the modified Software to carry prominent - notices stating that you changed specified portions of - the Software. - - This software was authored by: - - Argonne National Laboratory - J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov - Mathematics and Computer Science Division - Argonne National Laboratory, Argonne, IL 60439 - - ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES - OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, - AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A - CONTRACT WITH THE DEPARTMENT OF ENERGY. - - GOVERNMENT LICENSE AND DISCLAIMER - - This computer code material was prepared, in part, as an account - of work sponsored by an agency of the United States Government. - The Government is granted for itself and others acting on its - behalf a paid-up, nonexclusive, irrevocable worldwide license in - this data to reproduce, prepare derivative works, distribute - copies to the public, perform publicly and display publicly, and - to permit others to do so. NEITHER THE UNITED STATES GOVERNMENT - NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF - THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR - ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, - COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, - PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD - NOT INFRINGE PRIVATELY OWNED RIGHTS. - -***************************************************************************/ -/* sym.c - - Implementation dependent routines for using symtab_gen.c - in N32 . - -*/ - -#include -#include -#include "sym.h" -#include "protos.h" - -extern sym_nodeptr symget() ; - -static char ** symtab ; /* 2-19-90 */ - -int -sym_init() /* 2-19-90, initialize symbol table package */ -{ - create_ht( &symtab ) ; - if (symtab == NULL) - { - fprintf(stderr,"init_sym(): could not create hash table") ; - exit(1) ; - } - return(0) ; -} - -sym_nodeptr -sym_add( name ) -char * name ; -{ - sym_nodeptr new_sym_node(); - char **node_name() ; - sym_nodeptr *node_next() ; - return( symget( name, new_sym_node, node_name, node_next, symtab, 1 ) ) ; -} - -sym_nodeptr -sym_get( name ) -char * name ; -{ - sym_nodeptr new_sym_node(); - char **node_name() ; - sym_nodeptr *node_next() ; - return( symget( name, new_sym_node, node_name, node_next, symtab, 0 ) ) ; -} - -sym_nodeptr -new_sym_node() -{ - void * malloc() ; - sym_nodeptr p ; - p = (sym_nodeptr) malloc( sizeof( struct sym_node ) ) ; - p->name = NULL ; - p->next = NULL ; - - return( p ) ; -} - -char ** -node_name(p) -sym_nodeptr p ; -{ - char ** x ; - x = &(p->name) ; - return( x ) ; -} - -sym_nodeptr * -node_next(p) -sym_nodeptr p ; -{ - sym_nodeptr *x ; - x = &(p->next) ; - return( x ) ; -} - -int -show_entry(x) -sym_nodeptr x ; -{ - int i ; - if ( x == NULL ) return(0) ; - printf("Symbol table entry:\n") ; - printf("lexeme %s\n", x->name ) ; - printf(" dim %s\n", (x->dim==1?"M":(x->dim==2?"N":"O")) ) ; - printf(" ndims %d\n", x->ndims ) ; - for ( i = 0 ; i < x->ndims && i < 7 ; i++ ) - printf(" dim %d -> %s\n",i,(x->dims[i]==1?"M":(x->dims[i]==2?"N":"O")) ) ; - return(0) ; -} - -/* MEMORY LEAK !!!! -- this just abandons the old table and leaves on the heap. */ -/* The registry mechanism is not a long-running program and is not apt to - run into memory problems. Might want to fix this anyway, though, someday. */ -int -sym_forget() -{ - create_ht( &symtab ) ; - if (symtab == NULL) - { - fprintf(stderr,"init_sym(): could not create hash table") ; - exit(1) ; - } - return(0) ; -} - diff --git a/modules/openfast-registry/src/sym.h b/modules/openfast-registry/src/sym.h deleted file mode 100644 index 71de456860..0000000000 --- a/modules/openfast-registry/src/sym.h +++ /dev/null @@ -1,97 +0,0 @@ -/*********************************************************************** - - COPYRIGHT - - The following is a notice of limited availability of the code and - Government license and disclaimer which must be included in the - prologue of the code and in all source listings of the code. - - Copyright notice - (c) 1977 University of Chicago - - Permission is hereby granted to use, reproduce, prepare - derivative works, and to redistribute to others at no charge. If - you distribute a copy or copies of the Software, or you modify a - copy or copies of the Software or any portion of it, thus forming - a work based on the Software and make and/or distribute copies of - such work, you must meet the following conditions: - - a) If you make a copy of the Software (modified or verbatim) - it must include the copyright notice and Government - license and disclaimer. - - b) You must cause the modified Software to carry prominent - notices stating that you changed specified portions of - the Software. - - This software was authored by: - - Argonne National Laboratory - J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov - Mathematics and Computer Science Division - Argonne National Laboratory, Argonne, IL 60439 - - ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES - OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT, - AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A - CONTRACT WITH THE DEPARTMENT OF ENERGY. - - GOVERNMENT LICENSE AND DISCLAIMER - - This computer code material was prepared, in part, as an account - of work sponsored by an agency of the United States Government. - The Government is granted for itself and others acting on its - behalf a paid-up, nonexclusive, irrevocable worldwide license in - this data to reproduce, prepare derivative works, distribute - copies to the public, perform publicly and display publicly, and - to permit others to do so. NEITHER THE UNITED STATES GOVERNMENT - NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF - THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR - ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY, - COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS, - PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD - NOT INFRINGE PRIVATELY OWNED RIGHTS. - -***************************************************************************/ -#ifndef SYM_H -#define SYM_H - -/* file: sym.h - - Header info for symbol table module. - -*/ - -typedef struct sym_node * sym_nodeptr ; - -struct sym_node -{ - char * name ; /* lexeme */ - sym_nodeptr next ; /* pointer to next node in symbol table */ -/* fields that are associated with dimension declaration constants */ - unsigned char dim ; -/* fields that are associated with arrays */ - int ndims ; - int MDEX ; /* which index is the M dimension */ - int NDEX ; /* which index is the N dimension */ - unsigned char dims[7] ; - char dimname[7][64] ; -/* name of temporary variable associated with string. variable */ - char varx[32] ; -/* name of core association, July 2004 */ - char core_name[64] ; -/* internal name of variable associated with dataname entry, July 2004 */ - char internal_name[64] ; -/* fields associated with integer scalar variables */ - unsigned long info ; - unsigned long assigned ; /* pointer to assignment statement */ - unsigned long thisif ; - int iflev ; - int marked ; /* general purpose marker */ -} ; - -sym_nodeptr sym_add() ; -sym_nodeptr sym_get() ; -int sym_forget(); - -#endif diff --git a/modules/openfast-registry/src/symtab_gen.c b/modules/openfast-registry/src/symtab_gen.c deleted file mode 100644 index 944ce461b0..0000000000 --- a/modules/openfast-registry/src/symtab_gen.c +++ /dev/null @@ -1,208 +0,0 @@ -/* symtab.c - -Symbol Table Handler -- Generic - -The routine symget() returns a pointer to a C structure matching a -given lexeme. If the lexeme does not already exist in the symbol -table, the routine will create a new symbol structure, store it, and -then return a pointer to the newly created structure. - -It is up to the calling module to declare the symbol structure as -well as several routines for manipulating the symbol structure. The -routines are passed to symget as pointers. - - name type description - - newnode() *char returns a pointer to a symbol structure. - - nodename() **char retrieves the lexeme name from a symbol - structure, returned as a pointer to a - character array. - - nodenext() **char retrieves pointer to the next field of - the symbol structure (the next field - is itself a pointer to a symbol structure) - -For a sample main or calling program see the end of this file. - -**** - REVISED 2-19-90. Added code to make hashtable interchangible. - new routine: create_ht() creates new hashtable - rev routine: symget() added parameter to pass hash table -*/ - -#include -#include -#ifndef _WIN32 -# include -#endif - -#include "protos.h" - -#define HASHSIZE 1024 - -/* commented out 2-29-90 -static char * symtab[HASHSIZE] ; -*/ - -void * malloc() ; -void * calloc() ; - -char * symget(name,newnode,nodename,nodenext,symtab,flag) -char *name ; -char *(*newnode)(), **(*nodename)(), **(*nodenext)() ; -char *symtab[] ; -int flag ; /* 1 is create if not there, 0 return NULL if not there */ -{ - int index ; - int found ; - register char *s ; - register char *t ; - char **x ; - char *p ; - - index = hash( name ) ; - p = symtab[index] ; - found = 0 ; - - while (p) { - s = name ; - t = *(*nodename)(p) ; - while (*s && *t && *s == *t ) { - s++ ; - t++ ; - } - if (!*s && !*t) { - found = 1 ; - break ; - } - p = *(*nodenext)(p) ; - } - - if (!found ) { - if (flag ) { - p = (*newnode)() ; - x = (*nodename)(p) ; - *x = (char *) malloc(strlen(name)+1) ; - strcpy(*x,name) ; - x = (*nodenext)(p) ; - *x = symtab[index] ; - symtab[index] = p ; - } else { - return(NULL) ; - } - } - - return(p) ; -} - -int -hash(name) -char * name ; -{ - register int result = 0 ; - register char * p = name ; - - while (*p) - result = 3*result + (int)*p++ ; - - result = result % HASHSIZE ; - while (result < 0) - result = result + HASHSIZE ; - return(result) ; -} - - -/* added 2-19-90, attaches a new hash table to pointer */ - -int -create_ht( p ) -char *** p ; -{ - *p = (char **) calloc( HASHSIZE , sizeof( char * ) ) ; - return(0) ; -} - - -/* added 4-15-92. - -This is a generic routine that, given a hash table pointer, -will traverse the hash table and apply a caller supplied -function to each entry - -*/ - -int -sym_traverse( ht, nodenext, f ) -char *ht[] ; -char **(*nodenext)() ; -void (*f)() ; -{ - char * p, **x ; - int i ; - for ( i = 0 ; i < HASHSIZE ; i++ ) - { - if ( ( p = ht[i] ) != NULL ) - { - while ( p ) - { - (*f)(p) ; - x = (*nodenext)(p) ; - p = *x ; - } - } - } - return(0) ; -} - -/**********************************************************************/ -/**********************************************************************/ -/**********************************************************************/ - -#ifdef COMMENTOUTSAMPLE -/* sample_main.c - - sample main program for symget() in the file symtab.c - -*/ - -#include - -struct symnode { - char * name ; - struct symnode *next ; -} ; - -extern struct symnode * symget() ; - -struct symnode * -newnode() -{ - struct symnode * malloc() ; - return( malloc( sizeof( struct symnode ) ) ) ; -} - -char ** -nodename(p) -struct symnode *p ; -{ - char ** x ; - x = &(p->name) ; - return( x ) ; -} - -struct symnode ** -nodenext(p) -struct symnode *p ; -{ - struct symnode **x ; - x = &(p->next) ; - return( x ) ; -} - -#endif - -/**********************************************************************/ -/**********************************************************************/ -/**********************************************************************/ - diff --git a/modules/openfast-registry/src/templates.hpp b/modules/openfast-registry/src/templates.hpp new file mode 100644 index 0000000000..c4e05a8cb1 --- /dev/null +++ b/modules/openfast-registry/src/templates.hpp @@ -0,0 +1,973 @@ +#ifndef TEMPLATES_HPP +#define TEMPLATES_HPP + +#include + +const std::string FAST_preamble = R""""( +!STARTOFREGISTRYGENERATEDFILE 'ModuleName_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 +!********************************************************************************************************************************* +! ModuleName_Types +!................................................................................................................................. +! This file is part of ModuleName. +! +! 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 ModuleName. 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 ModuleName_Types +!--------------------------------------------------------------------------------------------------------------------------------- +)""""; + +const std::string registry_template = R""""( +################################################################################################################################### +# Registry for ModuleName in the FAST Modularization Framework +# This Registry file is used to create MODULE ModuleName_Types, which contains all of the user-defined types needed in ModuleName. +# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. +# +# Entries are of the form +# keyword +# +# Use ^ as a shortcut for the value from the previous line. +# See NWTC Programmer's Handbook at https://nwtc.nrel.gov/FAST-Developers for further information on the format/contents of this file. +################################################################################################################################### + +# ...... Include files (definitions from NWTC Library) ............................................................................ +include Registry_NWTC_Library.txt + + +# ..... Initialization data ....................................................................................................... +# Define inputs that the initialization routine may need here: +# e.g., the name of the input file, the file root name, etc. +typedef ModuleName/ModName InitInputType CHARACTER(1024) InputFile - - - \"Name of the input file; remove if there is no file\" - +typedef ^ ^ LOGICAL Linearize - .FALSE. - \"Flag that tells this module if the glue code wants to linearize.\" - + +# Define outputs from the initialization routine here: +typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - \"Names of the output-to-file channels\" - +typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - \"Units of the output-to-file channels\" - +# if this module has implemented linearization, return the names of the rows/columns of the Jacobian matrices: +#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - \"Names of the outputs used in linearization\" - +#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_x {:} - - \"Names of the continuous states used in linearization\" - +#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_xd {:} - - \"Names of the discrete states used in linearization\" - +#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_z {:} - - \"Names of the constraint states used in linearization\" - +#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_u {:} - - \"Names of the inputs used in linearization\" - +#typedef ^ InitOutputType LOGICAL RotFrame_y {:} - - \"Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame\" - +#typedef ^ InitOutputType LOGICAL RotFrame_x {:} - - \"Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame\" - +#typedef ^ InitOutputType LOGICAL RotFrame_xd {:} - - \"Flag that tells FAST if the discrete states used in linearization are in the rotating frame\" - +#typedef ^ InitOutputType LOGICAL RotFrame_z {:} - - \"Flag that tells FAST if the constraint states used in linearization are in the rotating frame\" - +#typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - \"Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame\" - +#typedef ^ InitOutputType LOGICAL IsLoad_u {:} - - \"Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrices)\" - +#typedef ^ InitOutputType IntKi DerivOrder_x {:} - - \"Integer that tells FAST/MBC3 the order derivative for the continuous states used in linearization\" - + + +# ..... States .................................................................................................................... +# Define continuous (differentiable) states here: +typedef ^ ContinuousStateType ReKi DummyContState - - - \"Remove this variable if you have continuous states\" - + +# Define discrete (nondifferentiable) states here: +typedef ^ DiscreteStateType ReKi DummyDiscState - - - \"Remove this variable if you have discrete states\" - + +# Define constraint states here: +typedef ^ ConstraintStateType ReKi DummyConstrState - - - \"Remove this variable if you have constraint states\" - + +# Define any other states, including integer or logical states here: +typedef ^ OtherStateType IntKi DummyOtherState - - - \"Remove this variable if you have other states\" - + + +# ..... 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 ReKi DummyMiscVar - - - \"Remove this variable if you have misc/optimization variables\" - + + +# ..... 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 DbKi DT - - - \"Time step for cont. state integration & disc. state update\" seconds + + +# ..... Inputs .................................................................................................................... +# Define inputs that are contained on the mesh here: +#typedef ^ InputType MeshType MeshedInput - - - \"Meshed data\" - +# Define inputs that are not on this mesh here: +typedef ^ InputType ReKi DummyInput - - - \"Remove this variable if you have input data\" - + + +# ..... Outputs ................................................................................................................... +# Define outputs that are contained on the mesh here: +#typedef ^ OutputType MeshType MeshedOutput - - - \"Meshed data\" - +# Define outputs that are not on this mesh here: +typedef ^ OutputType ReKi WriteOutput {:} - - \"Example of data to be written to an output file\" \"s,-\" +)""""; + +const std::string module_template = R""""( +!********************************************************************************************************************************** +!> ## ModuleName +!! The ModuleName and ModuleName_Types modules make up a template for creating user-defined calculations in the FAST Modularization +!! Framework. ModuleName_Types will be auto-generated by the FAST registry program, based on the variables specified in the +!! ModuleName_Registry.txt file. +!! +! .................................................................................................................................. +!! ## LICENSING +!! Copyright (C) 2012-2013, 2015-2016 National Renewable Energy Laboratory +!! +!! This file is part of ModuleName. +!! +!! 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. +!********************************************************************************************************************************** +MODULE ModuleName + + USE ModuleName_Types + USE NWTC_Library + + IMPLICIT NONE + + PRIVATE + + TYPE(ProgDesc), PARAMETER :: ModName_Ver = ProgDesc( 'ModuleName', '', '' ) !< module date/version information + + + ! ..... Public Subroutines ................................................................................................... + + PUBLIC :: ModName_Init ! Initialization routine + PUBLIC :: ModName_End ! Ending routine (includes clean up) + + PUBLIC :: ModName_UpdateStates ! Loose coupling routine for solving for constraint states, integrating + ! continuous states, and updating discrete states + PUBLIC :: ModName_CalcOutput ! Routine for computing outputs + + PUBLIC :: ModName_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual + PUBLIC :: ModName_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states + PUBLIC :: ModName_UpdateDiscState ! Tight coupling routine for updating discrete states + + PUBLIC :: ModName_JacobianPInput ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - + ! (Xd), and constraint - state(Z) functions all with respect to the inputs(u) + PUBLIC :: ModName_JacobianPContState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - + ! (Xd), and constraint - state(Z) functions all with respect to the continuous + ! states(x) + PUBLIC :: ModName_JacobianPDiscState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - + ! (Xd), and constraint - state(Z) functions all with respect to the discrete + ! states(xd) + PUBLIC :: ModName_JacobianPConstrState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - + ! (Xd), and constraint - state(Z) functions all with respect to the constraint + ! states(z) + PUBLIC :: ModName_GetOP ! Routine to get the operating-point values for linearization (from data structures to arrays) + +CONTAINS +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the start of the simulation to perform initialization steps. +!! The parameters are set here and not changed during the simulation. +!! The initial states and initial guess for the input are defined. +SUBROUTINE ModName_Init( InitInp, u, p, x, xd, z, OtherState, y, misc, Interval, InitOut, ErrStat, ErrMsg ) +!.................................................................................................................................. + + TYPE(ModName_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + TYPE(ModName_InputType), INTENT( OUT) :: u !< An initial guess for the input; input mesh must be defined + TYPE(ModName_ParameterType), INTENT( OUT) :: p !< Parameters + TYPE(ModName_ContinuousStateType), INTENT( OUT) :: x !< Initial continuous states + TYPE(ModName_DiscreteStateType), INTENT( OUT) :: xd !< Initial discrete states + TYPE(ModName_ConstraintStateType), INTENT( OUT) :: z !< Initial guess of the constraint states + TYPE(ModName_OtherStateType), INTENT( OUT) :: OtherState !< Initial other states (logical, etc) + TYPE(ModName_OutputType), INTENT( OUT) :: y !< Initial system outputs (outputs are not calculated; + !! only the output mesh is initialized) + TYPE(ModName_MiscVarType), INTENT( OUT) :: misc !< Misc variables for optimization (not copied in glue code) + REAL(DbKi), INTENT(INOUT) :: Interval !< Coupling interval in seconds: the rate that + !! (1) ModName_UpdateStates() is called in loose coupling & + !! (2) ModName_UpdateDiscState() is called in tight coupling. + !! Input is the suggested time from the glue code; + !! Output is the actual coupling interval that will be used + !! by the glue code. + TYPE(ModName_InitOutputType), INTENT( OUT) :: InitOut !< Output for initialization routine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + + INTEGER(IntKi) :: NumOuts ! number of outputs; would probably be in the parameter type + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'ModName_Init' + + !! Initialize variables + + ErrStat = ErrID_None + ErrMsg = '' + NumOuts = 2 + + + ! Initialize the NWTC Subroutine Library + + call NWTC_Init( ) + + ! Display the module information + + call DispNVD( ModName_Ver ) + + + ! Define parameters here: + + p%DT = Interval + + + ! Define initial system states here: + + x%DummyContState = 0.0_ReKi + xd%DummyDiscState = 0.0_ReKi + z%DummyConstrState = 0.0_ReKi + OtherState%DummyOtherState = 0.0_ReKi + + ! define optimization variables here: + misc%DummyMiscVar = 0.0_ReKi + + ! Define initial guess for the system inputs here: + + u%DummyInput = 0.0_ReKi + + + ! Define system output initializations (set up mesh) here: + call AllocAry( y%WriteOutput, NumOuts, 'WriteOutput', ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! set return error status based on local (concatenate errors) + if (ErrStat >= AbortErrLev) return ! if there are local variables that need to be deallocated, do so before early return + + y%DummyOutput = 0 + y%WriteOutput = 0 + + + ! Define initialization-routine output here: + call AllocAry(InitOut%WriteOutputHdr,NumOuts,'WriteOutputHdr',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry(InitOut%WriteOutputUnt,NumOuts,'WriteOutputUnt',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return ! if there are local variables that need to be deallocated, do so before early return + + InitOut%WriteOutputHdr = (/ 'Time ', 'Column2' /) + InitOut%WriteOutputUnt = (/ '(s)', '(-)' /) + + + ! If you want to choose your own rate instead of using what the glue code suggests, tell the glue code the rate at which + ! this module must be called here: + + !Interval = p%DT + + + if (InitInp%Linearize) then + + ! If this module does not implement the four Jacobian routines at the end of this template, or the module cannot + ! linearize with the features that are enabled, stop the simulation if InitInp%Linearize is true. + + CALL SetErrStat( ErrID_Fatal, 'ModuleName cannot perform linearization analysis.', ErrStat, ErrMsg, RoutineName) + + ! Otherwise, if the module does allow linearization, return the appropriate Jacobian row/column names and rotating-frame flags here: + ! Allocate and set these variables: InitOut%LinNames_y, InitOut%LinNames_x, InitOut%LinNames_xd, InitOut%LinNames_z, InitOut%LinNames_u + ! Allocate and set these variables: InitOut%RotFrame_y, InitOut%RotFrame_x, InitOut%RotFrame_xd, InitOut%RotFrame_z, InitOut%RotFrame_u + ! Allocate and set these variables: InitOut%IsLoad_u, InitOut%DerivOrder_x + + end if + + +END SUBROUTINE ModName_Init +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the end of the simulation. +SUBROUTINE ModName_End( u, p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ) +!.................................................................................................................................. + + TYPE(ModName_InputType), INTENT(INOUT) :: u !< System inputs + TYPE(ModName_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(ModName_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states + TYPE(ModName_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states + TYPE(ModName_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states + TYPE(ModName_OtherStateType), INTENT(INOUT) :: OtherState !< Other states + TYPE(ModName_OutputType), INTENT(INOUT) :: y !< System outputs + TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code) + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'ModName_End' + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + + + !! Place any last minute operations or calculations here: + + + !! Close files here (but because of checkpoint-restart capability, it is not recommended to have files open during the simulation): + + + !! Destroy the input data: + + call ModName_DestroyInput( u, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + + !! Destroy the parameter data: + + call ModName_DestroyParam( p, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + !! Destroy the state data: + + call ModName_DestroyContState( x, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call ModName_DestroyDiscState( xd, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call ModName_DestroyConstrState( z, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call ModName_DestroyOtherState( OtherState, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + + !! Destroy the output data: + + call ModName_DestroyOutput( y, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + + !! Destroy the misc data: + + call ModName_DestroyMisc( misc, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + +END SUBROUTINE ModName_End +!---------------------------------------------------------------------------------------------------------------------------------- +!> This is a loose coupling routine for solving constraint states, integrating continuous states, and updating discrete and other +!! states. Continuous, constraint, discrete, and other states are updated to values at t + Interval. +SUBROUTINE ModName_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, misc, ErrStat, ErrMsg ) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval + TYPE(ModName_InputType), INTENT(INOUT) :: Inputs(:) !< Inputs at InputTimes (output from this routine only + !! because of record keeping in routines that copy meshes) + REAL(DbKi), INTENT(IN ) :: InputTimes(:) !< Times in seconds associated with Inputs + TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ModName_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t; + !! Output: Continuous states at t + Interval + TYPE(ModName_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t; + !! Output: Discrete states at t + Interval + TYPE(ModName_ConstraintStateType), INTENT(INOUT) :: z !< Input: Constraint states at t; + !! Output: Constraint states at t + Interval + TYPE(ModName_OtherStateType), INTENT(INOUT) :: OtherState !< Other states: Other states at t; + !! Output: Other states at t + Interval + TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code) + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables + + TYPE(ModName_ContinuousStateType) :: dxdt ! Continuous state derivatives at t + TYPE(ModName_DiscreteStateType) :: xd_t ! Discrete states at t (copy) + TYPE(ModName_ConstraintStateType) :: z_Residual ! Residual of the constraint state functions (Z) + TYPE(ModName_InputType) :: u ! Instantaneous inputs + + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'ModName_UpdateStates' + + + ! Initialize variables + + ErrStat = ErrID_None ! no error has occurred + ErrMsg = '' + + + ! This subroutine contains an example of how the states could be updated. Developers will + ! want to adjust the logic as necessary for their own situations. + + + + ! Get the inputs at time t, based on the array of values sent by the glue code: + + ! before calling ExtrapInterp routine, memory in u must be allocated; we can do that with a copy: + call ModName_CopyInput( Inputs(1), u, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() ! to avoid memory leaks, we have to destroy the local variables that may have allocatable arrays or meshes + return + end if + + call ModName_Input_ExtrapInterp( Inputs, InputTimes, u, t, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + return + end if + + + + ! Get first time derivatives of continuous states (dxdt): + + call ModName_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, misc, dxdt, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + return + end if + + + ! Update discrete states: + ! Note that xd [discrete state] is changed in ModName_UpdateDiscState() so xd will now contain values at t+Interval + ! We'll first make a copy that contains xd at time t, which will be used in computing the constraint states + call ModName_CopyDiscState( xd, xd_t, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + return + end if + + call ModName_UpdateDiscState( t, n, u, p, x, xd, z, OtherState, misc, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + return + end if + + + ! Solve for the constraint states (z) here: + + ! Iterate until the value is within a given tolerance. + + ! DO + + call ModName_CalcConstrStateResidual( t, u, p, x, xd_t, z, OtherState, misc, Z_Residual, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + return + end if + + ! z = + + ! END DO + + + + ! Integrate (update) continuous states (x) here: + + !x = function of dxdt and x + + + ! Destroy local variables before returning + call cleanup() + + +CONTAINS + SUBROUTINE cleanup() + ! note that this routine inherits all of the data in ModName_UpdateStates + + + CALL ModName_DestroyInput( u, ErrStat2, ErrMsg2) + CALL ModName_DestroyConstrState( Z_Residual, ErrStat2, ErrMsg2) + CALL ModName_DestroyContState( dxdt, ErrStat2, ErrMsg2) + CALL ModName_DestroyDiscState( xd_t, ErrStat2, ErrMsg2) + + END SUBROUTINE cleanup +END SUBROUTINE ModName_UpdateStates +!---------------------------------------------------------------------------------------------------------------------------------- +!> This is a routine for computing outputs, used in both loose and tight coupling. +SUBROUTINE ModName_CalcOutput( t, u, p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t + TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t + TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t + TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t + TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t + TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code) + TYPE(ModName_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- + !! nectivity information does not have to be recalculated) + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + + + ! Compute outputs here: + y%DummyOutput = 2.0_ReKi + + y%WriteOutput(1) = REAL(t,ReKi) + y%WriteOutput(2) = 1.0_ReKi + + +END SUBROUTINE ModName_CalcOutput +!---------------------------------------------------------------------------------------------------------------------------------- +!> This is a tight coupling routine for computing derivatives of continuous states. +SUBROUTINE ModName_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, misc, dxdt, ErrStat, ErrMsg ) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t + TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t + TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t + TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t + TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t + TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code) + TYPE(ModName_ContinuousStateType), INTENT( OUT) :: dxdt !< Continuous state derivatives at t + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + + + ! Compute the first time derivatives of the continuous states here: + + dxdt%DummyContState = 0.0_ReKi + + +END SUBROUTINE ModName_CalcContStateDeriv +!---------------------------------------------------------------------------------------------------------------------------------- +!> This is a tight coupling routine for updating discrete states. +SUBROUTINE ModName_UpdateDiscState( t, n, u, p, x, xd, z, OtherState, misc, ErrStat, ErrMsg ) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval + TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t + TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t + TYPE(ModName_DiscreteStateType), INTENT(INOUT) :: xd !< Input: Discrete states at t; + !! Output: Discrete states at t + Interval + TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t + TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t + TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code) + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + + + ! Update discrete states here: + + xd%DummyDiscState = 0.0_Reki + +END SUBROUTINE ModName_UpdateDiscState +!---------------------------------------------------------------------------------------------------------------------------------- +!> This is a tight coupling routine for solving for the residual of the constraint state functions. +SUBROUTINE ModName_CalcConstrStateResidual( t, u, p, x, xd, z, OtherState, misc, Z_residual, ErrStat, ErrMsg ) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at t + TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t + TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t + TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t (possibly a guess) + TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t + TYPE(ModName_MiscVarType), INTENT(INOUT) :: misc !< Misc variables for optimization (not copied in glue code) + TYPE(ModName_ConstraintStateType), INTENT( OUT) :: Z_residual !< Residual of the constraint state functions using + !! the input values described above + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + + + ! Solve for the residual of the constraint state functions here: + + Z_residual%DummyConstrState = 0.0_ReKi + +END SUBROUTINE ModName_CalcConstrStateResidual + + +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! ###### The following four routines are Jacobian routines for linearization capabilities ####### +! If the module does not implement them, set ErrStat = ErrID_Fatal in ModName_Init() when InitInp%Linearize is .true. +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions +!! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. +SUBROUTINE ModName_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); + !! Output fields are not used by this routine, but type is + !! available here so that mesh parameter information (i.e., + !! connectivity) does not have to be recalculated for dYdu. + TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect + !! to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with + !! respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with + !! respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with + !! respect to the inputs (u) [intent in to avoid deallocation] + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + + + IF ( PRESENT( dYdu ) ) THEN + + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + + ! allocate and set dYdu + + END IF + + IF ( PRESENT( dXdu ) ) THEN + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: + + ! allocate and set dXdu + + END IF + + IF ( PRESENT( dXddu ) ) THEN + + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the inputs (u) here: + + ! allocate and set dXddu + + END IF + + IF ( PRESENT( dZdu ) ) THEN + + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the inputs (u) here: + + ! allocate and set dZdu + + END IF + + +END SUBROUTINE ModName_JacobianPInput +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions +!! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. +SUBROUTINE ModName_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); + !! Output fields are not used by this routine, but type is + !! available here so that mesh parameter information (i.e., + !! connectivity) does not have to be recalculated for dYdx. + TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions + !! (Y) with respect to the continuous + !! states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state + !! functions (X) with respect to + !! the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state + !! functions (Xd) with respect to + !! the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state + !! functions (Z) with respect to + !! the continuous states (x) [intent in to avoid deallocation] + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + + + + IF ( PRESENT( dYdx ) ) THEN + + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + + ! allocate and set dYdx + + END IF + + IF ( PRESENT( dXdx ) ) THEN + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + + ! allocate and set dXdx + + END IF + + IF ( PRESENT( dXddx ) ) THEN + + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the continuous states (x) here: + + ! allocate and set dXddx + + END IF + + IF ( PRESENT( dZdx ) ) THEN + + + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the continuous states (x) here: + + ! allocate and set dZdx + + END IF + + +END SUBROUTINE ModName_JacobianPContState +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions +!! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd are returned. +SUBROUTINE ModName_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); + !! Output fields are not used by this routine, but type is + !! available here so that mesh parameter information (i.e., + !! connectivity) does not have to be recalculated for dYdxd. + TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdxd(:,:) !< Partial derivatives of output functions + !! (Y) with respect to the discrete + !! states (xd) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdxd(:,:) !< Partial derivatives of continuous state + !! functions (X) with respect to the + !! discrete states (xd) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddxd(:,:)!< Partial derivatives of discrete state + !! functions (Xd) with respect to the + !! discrete states (xd) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdxd(:,:) !< Partial derivatives of constraint state + !! functions (Z) with respect to the + !! discrete states (xd) [intent in to avoid deallocation] + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + + + IF ( PRESENT( dYdxd ) ) THEN + + ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd) here: + + ! allocate and set dYdxd + + END IF + + IF ( PRESENT( dXdxd ) ) THEN + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd) here: + + ! allocate and set dXdxd + + END IF + + IF ( PRESENT( dXddxd ) ) THEN + + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd) here: + + ! allocate and set dXddxd + + END IF + + IF ( PRESENT( dZdxd ) ) THEN + + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd) here: + + ! allocate and set dZdxd + + END IF + + +END SUBROUTINE ModName_JacobianPDiscState +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions +!! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and dZ/dz are returned. +SUBROUTINE ModName_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); + !! Output fields are not used by this routine, but type is + !! available here so that mesh parameter information (i.e., + !! connectivity) does not have to be recalculated for dYdz. + TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdz(:,:) !< Partial derivatives of output + !! functions (Y) with respect to the + !! constraint states (z) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdz(:,:) !< Partial derivatives of continuous + !! state functions (X) with respect to + !! the constraint states (z) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddz(:,:) !< Partial derivatives of discrete state + !! functions (Xd) with respect to the + !! constraint states (z) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdz(:,:) !< Partial derivatives of constraint + !! state functions (Z) with respect to + !! the constraint states (z) [intent in to avoid deallocation] + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + + IF ( PRESENT( dYdz ) ) THEN + + ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here: + + ! allocate and set dYdz + + END IF + + IF ( PRESENT( dXdz ) ) THEN + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the constraint states (z) here: + + ! allocate and set dXdz + + END IF + + IF ( PRESENT( dXddz ) ) THEN + + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the constraint states (z) here: + + ! allocate and set dXddz + + END IF + + IF ( PRESENT( dZdz ) ) THEN + + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here: + + ! allocate and set dZdz + + END IF + + +END SUBROUTINE ModName_JacobianPConstrState +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine to pack the data structures representing the operating points into arrays for linearization. +SUBROUTINE ModName_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) + + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(ModName_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(ModName_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ModName_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(ModName_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(ModName_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(ModName_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(ModName_OutputType), INTENT(IN ) :: y !< Output at operating point + TYPE(ModName_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + + IF ( PRESENT( u_op ) ) THEN + + END IF + + IF ( PRESENT( y_op ) ) THEN + END IF + + IF ( PRESENT( x_op ) ) THEN + + END IF + + IF ( PRESENT( dx_op ) ) THEN + + END IF + + IF ( PRESENT( xd_op ) ) THEN + + END IF + + IF ( PRESENT( z_op ) ) THEN + + END IF + +END SUBROUTINE ModName_GetOP +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +END MODULE ModuleName +!********************************************************************************************************************************** +)""""; + +#endif \ No newline at end of file diff --git a/modules/openfast-registry/src/type.c b/modules/openfast-registry/src/type.c deleted file mode 100644 index 5c3f19ace2..0000000000 --- a/modules/openfast-registry/src/type.c +++ /dev/null @@ -1,428 +0,0 @@ -#include -#include -#include -#include -#ifdef _WIN32 -# define rindex(X,Y) strrchr(X,Y) -# define index(X,Y) strchr(X,Y) -#else -# include -#endif - - -#include "registry.h" -#include "protos.h" -#include "data.h" - -int -init_type_table() -{ - node_t *p ; - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "integer" ) ; - strcpy( p->mapsto, "INTEGER(IntKi)") ; - add_node_to_end ( p , &Type ) ; - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "intki" ) ; - strcpy( p->mapsto, "INTEGER(IntKi)") ; - add_node_to_end ( p , &Type ) ; - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "b4ki" ) ; // this won't necesarially work as intended! - strcpy( p->mapsto, "INTEGER(IntKi)") ; - add_node_to_end ( p , &Type ) ; - - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "real" ) ; - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "real" ) ; - strcpy( p->mapsto, "REAL(ReKi)") ; - add_node_to_end ( p , &Type ) ; - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "reki" ) ; - strcpy( p->mapsto, "REAL(ReKi)") ; - add_node_to_end ( p , &Type ) ; - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "siki" ) ; - strcpy( p->mapsto, "REAL(SiKi)") ; - add_node_to_end ( p , &Type ) ; - - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "logical" ) ; - strcpy( p->mapsto, "LOGICAL") ; - add_node_to_end ( p , &Type ) ; - -#if 0 // bjj: would like to add this back to see if we can use this for pack/unpack -// these have to be handled individually because people can and will put lengths after them -// so can't make a generic type node here - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "character" ) ; - strcpy( p->mapsto, "CHARACTER") /**/ ; - add_node_to_end ( p , &Type ) ; -#endif - - - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "doubleprecision" ) ; - strcpy( p->mapsto, "REAL(DbKi)") ; - add_node_to_end ( p , &Type ) ; - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "dbki" ) ; - strcpy( p->mapsto, "REAL(DbKi)") ; - add_node_to_end ( p , &Type ) ; - p = new_node(TYPE) ; p->type_type = SIMPLE ; strcpy( p->name , "r8ki" ) ; - strcpy( p->mapsto, "REAL(R8Ki)") ; - add_node_to_end ( p , &Type ) ; - p = new_node(TYPE) ; p->type_type = DERIVED ; strcpy( p->name , "meshtype" ) ; - strcpy( p->mapsto, "MeshType") ; - add_node_to_end ( p , &Type ) ; - p = new_node(TYPE) ; p->type_type = DERIVED ; strcpy( p->name , "dll_type" ) ; - strcpy( p->mapsto, "DLL_Type") ; - add_node_to_end ( p , &Type ) ; - - return(0) ; -} - - - -/* return the C equivalent of the simple Fortran types, expects the "mapsto" strings, set above */ -char * -C_type( char * s ) -{ - if ( !strcmp( s, "INTEGER(IntKi)") ) return("int" ) ; - if ( !strcmp( s, "LOGICAL" ) ) return("bool" ) ; - if (!strcmp(s, "REAL(ReKi)")) return("float"); - if (!strcmp(s, "REAL(SiKi)")) return("float"); - if (!strcmp(s, "REAL(DbKi)")) return("double"); - if (!strcmp(s, "REAL(R8Ki)")) return("double"); - if (!strncmp(s, "CHARACTER", 9)) return("char"); - return("unknown") ; -} - -char * -c_types_binding( char *s ) -{ - char * str_to_return = "CHARACTER(KIND=C_CHAR), DIMENSION("; - char * name_with_extension; - - - if ( !strcmp( s, "INTEGER(IntKi)") ) return("INTEGER(KIND=C_INT)" ) ; - if ( !strcmp( s, "LOGICAL" ) ) return("LOGICAL(KIND=C_BOOL)") ; - if (!strcmp(s, "REAL(ReKi)")) return("REAL(KIND=C_FLOAT)"); - if (!strcmp(s, "REAL(SiKi)")) return("REAL(KIND=C_FLOAT)"); - if (!strcmp(s, "REAL(DbKi)")) return("REAL(KIND=C_DOUBLE)"); - if (!strcmp(s, "REAL(R8Ki)")) return("REAL(KIND=C_DOUBLE)"); - if (!strncmp(s, "CHARACTER", 9)) { // give the C string a length identical to the fortran type - char *p = s, buf[10]; - while ( *p ) { - if ( isdigit(*p) ) { - long val = strtol( p, &p, 10 ); - snprintf( buf, 10, "%lu", val ); - } else { - p++; - } - } - - - name_with_extension = malloc(strlen(str_to_return)+15); // memory leak, should take care of this ? //bjj: made it larger to account for size of buf - strcpy(name_with_extension, str_to_return); - strcat(name_with_extension, buf); - strcat(name_with_extension, ")"); - - return name_with_extension; - }; - return("unknown") ; -} - -char * -assoc_or_allocated( node_t * r ) -{ - - if ( is_pointer(r) ){ - return("ASSOCIATED"); - } else { - return("ALLOCATED"); - } - -} - -int -is_pointer( node_t * r ) -{ - if (r->ndims > 0 && r->dims[0]->is_pointer) { - return(1); - } - if ( sw_ccode && r->ndims > 0 && r->dims[0]->deferred ){ - if ( !strncmp( make_lower_temp(r-> name), "writeoutput", 11) ) { // this covers WriteOutput, WriteOutputHdr, and WriteOutputUnt - return( 0 ); // we're going to use these in the glue code, so these will be a special case - } else if (r->type->type_type == DERIVED){ - return(0); // derived types aren't passed through the c-interface, so don't make them pointers - } else { - return(1); - } - } else { - return( 0 ); - } - -} - - -int -set_state_dims ( char * dims , node_t * node ) -{ - int modifiers ; - node_t *d, *d1 ; - char *c ; - char dspec[NAMELEN] ; - int inbrace ; - - if ( dims == NULL ) dims = "-" ; - modifiers = 0 ; - node->ndims = 0 ; - node->boundary_array = 0 ; - - inbrace = 0 ; - node->subgrid = 0 ; - strcpy(dspec,"") ; - for ( c = dims ; *c ; c++ ) - { - if ( *c == '-' && ! inbrace ) - { - break ; - } - else if ( *c == '{' && ! inbrace ) - { - inbrace = 1 ; - continue ; - } - else if ( modifiers == 0 ) - { - if ( *c == '}' && inbrace ) { inbrace = 0 ; } - else { int n = strlen(dspec) ; dspec[n] = *c ; dspec[n+1]='\0' ; } - if ( inbrace ) { - continue ; - } - d1 = new_node(DIM) ; /* make a copy */ - if (( d = get_dim_entry ( dspec, 1 )) != NULL ) { - *d1 = *d ; - } else { - set_dim_len( dspec , d1 ) ; - } - node->dims[node->ndims++] = d1 ; - strcpy(dspec,"") ; - } - } - // check to make sure that if any dimension is deferred they all must be - - has_deferred_dim( node, 1 ) ; - - return (0) ; -} - -int -has_deferred_dim( node_t * node, int noisy ) -{ - int deferred, i ; - deferred = 0 ; - if ( node->ndims > 0 ) { - deferred = node->dims[0]->deferred ; - for ( i = 1 ; i < node->ndims ; i++ ) - { - if ( deferred != node->dims[i]->deferred ) { - if ( node->dims[i]->deferred ) { - if ( noisy ) fprintf(stderr, - "Registry warning: dimension %d of %s is allocatable while others are not.\n",i,node->name) ; - } else { - if ( noisy ) fprintf(stderr, - "Registry warning: dimension %d of %s is not allocatable while others are.\n",i,node->name) ; - } - } - if ( node->dims[i]->deferred ) deferred = 1 ; - } - } - return(deferred) ; -} - -#if 0 -node_t * -get_4d_entry ( char * name ) -{ - node_t *p ; - if ( name == NULL ) return (NULL) ; - for ( p = FourD ; p != NULL ; p = p->next4d ) - { - if ( !strcmp( p->name , name ) ) - { - return(p) ; - } - } - return(NULL) ; -} -#endif - -node_t * -get_type_entry ( char * typename ) -{ - node_t * retval ; - retval = get_entry(typename,Type) ; - return(retval) ; -} - -node_t * -get_modname_entry ( char * modname ) -{ - return(get_entry(modname,ModNames)) ; -} - -node_t * -get_rconfig_entry ( char * name ) -{ - node_t * p ; - if ((p=get_entry(name,Domain.fields))==NULL) return(NULL) ; - if (p->node_kind & RCONFIG) return(p) ; - return(NULL) ; -} - -node_t * -get_entry ( char * name , node_t * node ) -{ - node_t *p ; - char tmp[NAMELEN] ; - if ( name == NULL ) return (NULL) ; - if ( node == NULL ) return (NULL) ; - strcpy( tmp, name ) ; - make_lower_temp(tmp) ; - for ( p = node ; p != NULL ; p = p->next ) - { - if ( !strncmp( name , "character", 9 ) ) - { - if ( !strncmp( p->name , name, 9 ) ) - { - return(p) ; - } - } else { - if ( !strcmp( make_lower_temp(p->name) , tmp ) ) - { - return(p) ; - } - } - } - return(NULL) ; -} - -/* this gets the entry for the node even if it */ -/* is a derived data structure; does this by following */ -/* the fully specified f90 reference. For example: */ -/* "xa%f" for the field of derived type xa. */ -/* note it will also take care to ignore the _1 or _2 */ -/* suffixes from variables that have ntl > 1 */ -/* 11/10/2001 -- added use field; if the entry has a use */ -/* that starts with "dyn_" and use doesn't correspond to */ -/* that, skip that entry and continue */ - -node_t * -get_entry_r ( char * name , char * use , node_t * node ) -{ - node_t *p ; - char tmp[NAMELEN], *t1, *t2 ; - - if ( name == NULL ) return (NULL) ; - if ( node == NULL ) return (NULL) ; - - for ( p = node ; p != NULL ; p = p->next ) - { - strcpy( tmp, name ) ; - - /* first check for exact match */ - if ( !strcmp( p->name , tmp ) ) - { - return(p) ; - } - - t1 = NULL ; - if ((t1 = index(tmp,'%'))!= NULL ) *t1 = '\0' ; - - if ( p->ntl > 1 ) - { - if (( t2 = rindex( tmp , '_' )) != NULL ) - { - /* be sure it really is an integer that follows the _ and that */ - /* that is that is the last character */ - if ((*(t2+1) >= '0' && *(t2+1) <= '9') && *(t2+2)=='\0') *t2 = '\0' ; - } - } - - /* also allow _tend */ - if (( t2 = rindex( tmp , '_' )) != NULL ) { - if (!strcmp(t2,"_tend")) *t2 = '\0' ; - } - - /* also allow _tend */ - if (( t2 = rindex( tmp , '_' )) != NULL ) { - if (!strcmp(t2,"_old")) *t2 = '\0' ; - } - - if ( !strcmp( p->name , tmp ) ) - { - if ( t1 != NULL ) return( get_entry_r( t1+1 , use , p->type->fields ) ) ; - return(p) ; - } - } - return(NULL) ; -} - -node_t * -get_dimnode_for_coord ( node_t * node , int coord_axis ) -{ - int i ; - if ( node == NULL ) return(NULL) ; - for ( i = 0 ; i < node->ndims ; i++ ) - { - if ( node->dims[i] == NULL ) continue ; - if ( node->dims[i]->coord_axis == coord_axis ) - { - return(node->dims[i]) ; - } - } - return(NULL) ; -} - -int -get_index_for_coord ( node_t * node , int coord_axis ) -{ - int i ; - if ( node == NULL ) return( -1 ) ; - for ( i = 0 ; i < node->ndims ; i++ ) - { - if ( node->dims[i] == NULL ) continue ; - if ( node->dims[i]->coord_axis == coord_axis ) - { - return(i) ; - } - } - return(-1) ; -} - - -char * -set_mem_order( node_t * node , char * str , int n ) -{ - int i ; - node_t * p ; - - if ( str == NULL || node == NULL ) return(NULL) ; - strcpy(str,"") ; - if ( node->boundary_array ) - { - strcpy(str, "C") ; /* if this is called for a boundary array, just give it a */ - /* "reasonable" value and move on. */ - } - else - { - if ( node->ndims <= 0 ) - { - strcat(str,"0") ; return(str) ; - } - for ( i = 0 ; i < node->ndims && i < n ; i++ ) - { - p = node->dims[i] ; - switch( p->coord_axis ) - { - case(COORD_X) : strcat(str,"X") ; break ; - case(COORD_Y) : strcat(str,"Y") ; break ; - case(COORD_Z) : strcat(str,"Z") ; break ; - case(COORD_C) : strcat(str,"C") ; break ; - default : break ; - } - } - } - return(str) ; -} diff --git a/modules/openfoam/src/OpenFOAM_Types.f90 b/modules/openfoam/src/OpenFOAM_Types.f90 index 3613f4b483..6a5d8fe0fc 100644 --- a/modules/openfoam/src/OpenFOAM_Types.f90 +++ b/modules/openfoam/src/OpenFOAM_Types.f90 @@ -31,7 +31,6 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE OpenFOAM_Types !--------------------------------------------------------------------------------------------------------------------------------- -!USE, INTRINSIC :: ISO_C_Binding USE NWTC_Library IMPLICIT NONE ! ========= OpFM_InitInputType_C ======= @@ -231,9 +230,9 @@ SUBROUTINE OpFM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%StructBldRNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInitInputData%c_obj%StructBldRNodes_Len = SIZE(DstInitInputData%StructBldRNodes) - IF (DstInitInputData%c_obj%StructBldRNodes_Len > 0) & - DstInitInputData%c_obj%StructBldRNodes = C_LOC( DstInitInputData%StructBldRNodes( i1_l ) ) + DstInitInputData%C_obj%StructBldRNodes_Len = SIZE(DstInitInputData%StructBldRNodes) + IF (DstInitInputData%C_obj%StructBldRNodes_Len > 0) & + DstInitInputData%C_obj%StructBldRNodes = C_LOC( DstInitInputData%StructBldRNodes( i1_l ) ) END IF DstInitInputData%StructBldRNodes = SrcInitInputData%StructBldRNodes ENDIF @@ -246,9 +245,9 @@ SUBROUTINE OpFM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%StructTwrHNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInitInputData%c_obj%StructTwrHNodes_Len = SIZE(DstInitInputData%StructTwrHNodes) - IF (DstInitInputData%c_obj%StructTwrHNodes_Len > 0) & - DstInitInputData%c_obj%StructTwrHNodes = C_LOC( DstInitInputData%StructTwrHNodes( i1_l ) ) + DstInitInputData%C_obj%StructTwrHNodes_Len = SIZE(DstInitInputData%StructTwrHNodes) + IF (DstInitInputData%C_obj%StructTwrHNodes_Len > 0) & + DstInitInputData%C_obj%StructTwrHNodes = C_LOC( DstInitInputData%StructTwrHNodes( i1_l ) ) END IF DstInitInputData%StructTwrHNodes = SrcInitInputData%StructTwrHNodes ENDIF @@ -262,14 +261,12 @@ SUBROUTINE OpFM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%C_obj%NodeClusterType = SrcInitInputData%C_obj%NodeClusterType END SUBROUTINE OpFM_CopyInitInput - SUBROUTINE OpFM_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE OpFM_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyInitInput' @@ -277,23 +274,13 @@ SUBROUTINE OpFM_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ASSOCIATED(InitInputData%StructBldRNodes)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InitInputData%StructBldRNodes) - InitInputData%StructBldRNodes => NULL() InitInputData%C_obj%StructBldRNodes = C_NULL_PTR InitInputData%C_obj%StructBldRNodes_Len = 0 ENDIF IF (ASSOCIATED(InitInputData%StructTwrHNodes)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InitInputData%StructTwrHNodes) - InitInputData%StructTwrHNodes => NULL() InitInputData%C_obj%StructTwrHNodes = C_NULL_PTR InitInputData%C_obj%StructTwrHNodes_Len = 0 ENDIF @@ -469,9 +456,9 @@ SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StructBldRNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%StructBldRNodes_Len = SIZE(OutData%StructBldRNodes) - IF (OutData%c_obj%StructBldRNodes_Len > 0) & - OutData%c_obj%StructBldRNodes = C_LOC( OutData%StructBldRNodes( i1_l ) ) + OutData%C_obj%StructBldRNodes_Len = SIZE(OutData%StructBldRNodes) + IF (OutData%C_obj%StructBldRNodes_Len > 0) & + OutData%C_obj%StructBldRNodes = C_LOC( OutData%StructBldRNodes( i1_l ) ) DO i1 = LBOUND(OutData%StructBldRNodes,1), UBOUND(OutData%StructBldRNodes,1) OutData%StructBldRNodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -490,9 +477,9 @@ SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StructTwrHNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%StructTwrHNodes_Len = SIZE(OutData%StructTwrHNodes) - IF (OutData%c_obj%StructTwrHNodes_Len > 0) & - OutData%c_obj%StructTwrHNodes = C_LOC( OutData%StructTwrHNodes( i1_l ) ) + OutData%C_obj%StructTwrHNodes_Len = SIZE(OutData%StructTwrHNodes) + IF (OutData%C_obj%StructTwrHNodes_Len > 0) & + OutData%C_obj%StructTwrHNodes = C_LOC( OutData%StructTwrHNodes( i1_l ) ) DO i1 = LBOUND(OutData%StructTwrHNodes,1), UBOUND(OutData%StructTwrHNodes,1) OutData%StructTwrHNodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -574,24 +561,24 @@ SUBROUTINE OpFM_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ! -- StructBldRNodes InitInput Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InitInputData%StructBldRNodes)) THEN - InitInputData%c_obj%StructBldRNodes_Len = 0 - InitInputData%c_obj%StructBldRNodes = C_NULL_PTR + InitInputData%C_obj%StructBldRNodes_Len = 0 + InitInputData%C_obj%StructBldRNodes = C_NULL_PTR ELSE - InitInputData%c_obj%StructBldRNodes_Len = SIZE(InitInputData%StructBldRNodes) - IF (InitInputData%c_obj%StructBldRNodes_Len > 0) & - InitInputData%c_obj%StructBldRNodes = C_LOC( InitInputData%StructBldRNodes( LBOUND(InitInputData%StructBldRNodes,1) ) ) + InitInputData%C_obj%StructBldRNodes_Len = SIZE(InitInputData%StructBldRNodes) + IF (InitInputData%C_obj%StructBldRNodes_Len > 0) & + InitInputData%C_obj%StructBldRNodes = C_LOC( InitInputData%StructBldRNodes( LBOUND(InitInputData%StructBldRNodes,1) ) ) END IF END IF ! -- StructTwrHNodes InitInput Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InitInputData%StructTwrHNodes)) THEN - InitInputData%c_obj%StructTwrHNodes_Len = 0 - InitInputData%c_obj%StructTwrHNodes = C_NULL_PTR + InitInputData%C_obj%StructTwrHNodes_Len = 0 + InitInputData%C_obj%StructTwrHNodes = C_NULL_PTR ELSE - InitInputData%c_obj%StructTwrHNodes_Len = SIZE(InitInputData%StructTwrHNodes) - IF (InitInputData%c_obj%StructTwrHNodes_Len > 0) & - InitInputData%c_obj%StructTwrHNodes = C_LOC( InitInputData%StructTwrHNodes( LBOUND(InitInputData%StructTwrHNodes,1) ) ) + InitInputData%C_obj%StructTwrHNodes_Len = SIZE(InitInputData%StructTwrHNodes) + IF (InitInputData%C_obj%StructTwrHNodes_Len > 0) & + InitInputData%C_obj%StructTwrHNodes = C_LOC( InitInputData%StructTwrHNodes( LBOUND(InitInputData%StructTwrHNodes,1) ) ) END IF END IF InitInputData%C_obj%BladeLength = InitInputData%BladeLength @@ -644,14 +631,12 @@ SUBROUTINE OpFM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE OpFM_CopyInitOutput - SUBROUTINE OpFM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE OpFM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyInitOutput' @@ -659,19 +644,13 @@ SUBROUTINE OpFM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) ENDIF IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN DEALLOCATE(InitOutputData%WriteOutputUnt) ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE OpFM_DestroyInitOutput @@ -722,7 +701,7 @@ SUBROUTINE OpFM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -801,7 +780,7 @@ SUBROUTINE OpFM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err END DO ! I END DO END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -931,7 +910,7 @@ SUBROUTINE OpFM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1055,14 +1034,12 @@ SUBROUTINE OpFM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE OpFM_CopyMisc - SUBROUTINE OpFM_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE OpFM_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyMisc' @@ -1070,12 +1047,6 @@ SUBROUTINE OpFM_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MiscData%ActForceMotionsPoints)) THEN DO i1 = LBOUND(MiscData%ActForceMotionsPoints,1), UBOUND(MiscData%ActForceMotionsPoints,1) CALL MeshDestroy( MiscData%ActForceMotionsPoints(i1), ErrStat2, ErrMsg2 ) @@ -1092,14 +1063,14 @@ SUBROUTINE OpFM_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(MiscData%Line2_to_Point_Loads)) THEN DO i1 = LBOUND(MiscData%Line2_to_Point_Loads,1), UBOUND(MiscData%Line2_to_Point_Loads,1) - CALL NWTC_Library_Destroymeshmaptype( MiscData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( MiscData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%Line2_to_Point_Loads) ENDIF IF (ALLOCATED(MiscData%Line2_to_Point_Motions)) THEN DO i1 = LBOUND(MiscData%Line2_to_Point_Motions,1), UBOUND(MiscData%Line2_to_Point_Motions,1) - CALL NWTC_Library_Destroymeshmaptype( MiscData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( MiscData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%Line2_to_Point_Motions) @@ -1193,7 +1164,7 @@ SUBROUTINE OpFM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_BufSz = Int_BufSz + 2*1 ! Line2_to_Point_Loads upper/lower bounds for each dimension DO i1 = LBOUND(InData%Line2_to_Point_Loads,1), UBOUND(InData%Line2_to_Point_Loads,1) Int_BufSz = Int_BufSz + 3 ! Line2_to_Point_Loads: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Line2_to_Point_Loads + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Line2_to_Point_Loads CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1216,7 +1187,7 @@ SUBROUTINE OpFM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_BufSz = Int_BufSz + 2*1 ! Line2_to_Point_Motions upper/lower bounds for each dimension DO i1 = LBOUND(InData%Line2_to_Point_Motions,1), UBOUND(InData%Line2_to_Point_Motions,1) Int_BufSz = Int_BufSz + 3 ! Line2_to_Point_Motions: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Line2_to_Point_Motions + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Line2_to_Point_Motions CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1356,7 +1327,7 @@ SUBROUTINE OpFM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%Line2_to_Point_Loads,1), UBOUND(InData%Line2_to_Point_Loads,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2, OnlySize ) ! Line2_to_Point_Loads + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2, OnlySize ) ! Line2_to_Point_Loads CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1397,7 +1368,7 @@ SUBROUTINE OpFM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%Line2_to_Point_Motions,1), UBOUND(InData%Line2_to_Point_Motions,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2, OnlySize ) ! Line2_to_Point_Motions + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2, OnlySize ) ! Line2_to_Point_Motions CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1615,7 +1586,7 @@ SUBROUTINE OpFM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2 ) ! Line2_to_Point_Loads + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2 ) ! Line2_to_Point_Loads CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1671,7 +1642,7 @@ SUBROUTINE OpFM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2 ) ! Line2_to_Point_Motions + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2 ) ! Line2_to_Point_Motions CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1754,9 +1725,9 @@ SUBROUTINE OpFM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%forceBldRnodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstParamData%c_obj%forceBldRnodes_Len = SIZE(DstParamData%forceBldRnodes) - IF (DstParamData%c_obj%forceBldRnodes_Len > 0) & - DstParamData%c_obj%forceBldRnodes = C_LOC( DstParamData%forceBldRnodes( i1_l ) ) + DstParamData%C_obj%forceBldRnodes_Len = SIZE(DstParamData%forceBldRnodes) + IF (DstParamData%C_obj%forceBldRnodes_Len > 0) & + DstParamData%C_obj%forceBldRnodes = C_LOC( DstParamData%forceBldRnodes( i1_l ) ) END IF DstParamData%forceBldRnodes = SrcParamData%forceBldRnodes ENDIF @@ -1769,9 +1740,9 @@ SUBROUTINE OpFM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%forceTwrHnodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstParamData%c_obj%forceTwrHnodes_Len = SIZE(DstParamData%forceTwrHnodes) - IF (DstParamData%c_obj%forceTwrHnodes_Len > 0) & - DstParamData%c_obj%forceTwrHnodes = C_LOC( DstParamData%forceTwrHnodes( i1_l ) ) + DstParamData%C_obj%forceTwrHnodes_Len = SIZE(DstParamData%forceTwrHnodes) + IF (DstParamData%C_obj%forceTwrHnodes_Len > 0) & + DstParamData%C_obj%forceTwrHnodes = C_LOC( DstParamData%forceTwrHnodes( i1_l ) ) END IF DstParamData%forceTwrHnodes = SrcParamData%forceTwrHnodes ENDIF @@ -1785,14 +1756,12 @@ SUBROUTINE OpFM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%C_obj%NodeClusterType = SrcParamData%C_obj%NodeClusterType END SUBROUTINE OpFM_CopyParam - SUBROUTINE OpFM_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE OpFM_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyParam' @@ -1800,23 +1769,13 @@ SUBROUTINE OpFM_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ASSOCIATED(ParamData%forceBldRnodes)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(ParamData%forceBldRnodes) - ParamData%forceBldRnodes => NULL() ParamData%C_obj%forceBldRnodes = C_NULL_PTR ParamData%C_obj%forceBldRnodes_Len = 0 ENDIF IF (ASSOCIATED(ParamData%forceTwrHnodes)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(ParamData%forceTwrHnodes) - ParamData%forceTwrHnodes => NULL() ParamData%C_obj%forceTwrHnodes = C_NULL_PTR ParamData%C_obj%forceTwrHnodes_Len = 0 ENDIF @@ -2022,9 +1981,9 @@ SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%forceBldRnodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%forceBldRnodes_Len = SIZE(OutData%forceBldRnodes) - IF (OutData%c_obj%forceBldRnodes_Len > 0) & - OutData%c_obj%forceBldRnodes = C_LOC( OutData%forceBldRnodes( i1_l ) ) + OutData%C_obj%forceBldRnodes_Len = SIZE(OutData%forceBldRnodes) + IF (OutData%C_obj%forceBldRnodes_Len > 0) & + OutData%C_obj%forceBldRnodes = C_LOC( OutData%forceBldRnodes( i1_l ) ) DO i1 = LBOUND(OutData%forceBldRnodes,1), UBOUND(OutData%forceBldRnodes,1) OutData%forceBldRnodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -2043,9 +2002,9 @@ SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%forceTwrHnodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%forceTwrHnodes_Len = SIZE(OutData%forceTwrHnodes) - IF (OutData%c_obj%forceTwrHnodes_Len > 0) & - OutData%c_obj%forceTwrHnodes = C_LOC( OutData%forceTwrHnodes( i1_l ) ) + OutData%C_obj%forceTwrHnodes_Len = SIZE(OutData%forceTwrHnodes) + IF (OutData%C_obj%forceTwrHnodes_Len > 0) & + OutData%C_obj%forceTwrHnodes = C_LOC( OutData%forceTwrHnodes( i1_l ) ) DO i1 = LBOUND(OutData%forceTwrHnodes,1), UBOUND(OutData%forceTwrHnodes,1) OutData%forceTwrHnodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -2137,24 +2096,24 @@ SUBROUTINE OpFM_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ! -- forceBldRnodes Param Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(ParamData%forceBldRnodes)) THEN - ParamData%c_obj%forceBldRnodes_Len = 0 - ParamData%c_obj%forceBldRnodes = C_NULL_PTR + ParamData%C_obj%forceBldRnodes_Len = 0 + ParamData%C_obj%forceBldRnodes = C_NULL_PTR ELSE - ParamData%c_obj%forceBldRnodes_Len = SIZE(ParamData%forceBldRnodes) - IF (ParamData%c_obj%forceBldRnodes_Len > 0) & - ParamData%c_obj%forceBldRnodes = C_LOC( ParamData%forceBldRnodes( LBOUND(ParamData%forceBldRnodes,1) ) ) + ParamData%C_obj%forceBldRnodes_Len = SIZE(ParamData%forceBldRnodes) + IF (ParamData%C_obj%forceBldRnodes_Len > 0) & + ParamData%C_obj%forceBldRnodes = C_LOC( ParamData%forceBldRnodes( LBOUND(ParamData%forceBldRnodes,1) ) ) END IF END IF ! -- forceTwrHnodes Param Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(ParamData%forceTwrHnodes)) THEN - ParamData%c_obj%forceTwrHnodes_Len = 0 - ParamData%c_obj%forceTwrHnodes = C_NULL_PTR + ParamData%C_obj%forceTwrHnodes_Len = 0 + ParamData%C_obj%forceTwrHnodes = C_NULL_PTR ELSE - ParamData%c_obj%forceTwrHnodes_Len = SIZE(ParamData%forceTwrHnodes) - IF (ParamData%c_obj%forceTwrHnodes_Len > 0) & - ParamData%c_obj%forceTwrHnodes = C_LOC( ParamData%forceTwrHnodes( LBOUND(ParamData%forceTwrHnodes,1) ) ) + ParamData%C_obj%forceTwrHnodes_Len = SIZE(ParamData%forceTwrHnodes) + IF (ParamData%C_obj%forceTwrHnodes_Len > 0) & + ParamData%C_obj%forceTwrHnodes = C_LOC( ParamData%forceTwrHnodes( LBOUND(ParamData%forceTwrHnodes,1) ) ) END IF END IF ParamData%C_obj%BladeLength = ParamData%BladeLength @@ -2187,9 +2146,9 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pxVel.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%pxVel_Len = SIZE(DstInputData%pxVel) - IF (DstInputData%c_obj%pxVel_Len > 0) & - DstInputData%c_obj%pxVel = C_LOC( DstInputData%pxVel( i1_l ) ) + DstInputData%C_obj%pxVel_Len = SIZE(DstInputData%pxVel) + IF (DstInputData%C_obj%pxVel_Len > 0) & + DstInputData%C_obj%pxVel = C_LOC( DstInputData%pxVel( i1_l ) ) END IF DstInputData%pxVel = SrcInputData%pxVel ENDIF @@ -2202,9 +2161,9 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pyVel.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%pyVel_Len = SIZE(DstInputData%pyVel) - IF (DstInputData%c_obj%pyVel_Len > 0) & - DstInputData%c_obj%pyVel = C_LOC( DstInputData%pyVel( i1_l ) ) + DstInputData%C_obj%pyVel_Len = SIZE(DstInputData%pyVel) + IF (DstInputData%C_obj%pyVel_Len > 0) & + DstInputData%C_obj%pyVel = C_LOC( DstInputData%pyVel( i1_l ) ) END IF DstInputData%pyVel = SrcInputData%pyVel ENDIF @@ -2217,9 +2176,9 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pzVel.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%pzVel_Len = SIZE(DstInputData%pzVel) - IF (DstInputData%c_obj%pzVel_Len > 0) & - DstInputData%c_obj%pzVel = C_LOC( DstInputData%pzVel( i1_l ) ) + DstInputData%C_obj%pzVel_Len = SIZE(DstInputData%pzVel) + IF (DstInputData%C_obj%pzVel_Len > 0) & + DstInputData%C_obj%pzVel = C_LOC( DstInputData%pzVel( i1_l ) ) END IF DstInputData%pzVel = SrcInputData%pzVel ENDIF @@ -2232,9 +2191,9 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pxForce.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%pxForce_Len = SIZE(DstInputData%pxForce) - IF (DstInputData%c_obj%pxForce_Len > 0) & - DstInputData%c_obj%pxForce = C_LOC( DstInputData%pxForce( i1_l ) ) + DstInputData%C_obj%pxForce_Len = SIZE(DstInputData%pxForce) + IF (DstInputData%C_obj%pxForce_Len > 0) & + DstInputData%C_obj%pxForce = C_LOC( DstInputData%pxForce( i1_l ) ) END IF DstInputData%pxForce = SrcInputData%pxForce ENDIF @@ -2247,9 +2206,9 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pyForce.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%pyForce_Len = SIZE(DstInputData%pyForce) - IF (DstInputData%c_obj%pyForce_Len > 0) & - DstInputData%c_obj%pyForce = C_LOC( DstInputData%pyForce( i1_l ) ) + DstInputData%C_obj%pyForce_Len = SIZE(DstInputData%pyForce) + IF (DstInputData%C_obj%pyForce_Len > 0) & + DstInputData%C_obj%pyForce = C_LOC( DstInputData%pyForce( i1_l ) ) END IF DstInputData%pyForce = SrcInputData%pyForce ENDIF @@ -2262,9 +2221,9 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pzForce.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%pzForce_Len = SIZE(DstInputData%pzForce) - IF (DstInputData%c_obj%pzForce_Len > 0) & - DstInputData%c_obj%pzForce = C_LOC( DstInputData%pzForce( i1_l ) ) + DstInputData%C_obj%pzForce_Len = SIZE(DstInputData%pzForce) + IF (DstInputData%C_obj%pzForce_Len > 0) & + DstInputData%C_obj%pzForce = C_LOC( DstInputData%pzForce( i1_l ) ) END IF DstInputData%pzForce = SrcInputData%pzForce ENDIF @@ -2277,9 +2236,9 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%xdotForce.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%xdotForce_Len = SIZE(DstInputData%xdotForce) - IF (DstInputData%c_obj%xdotForce_Len > 0) & - DstInputData%c_obj%xdotForce = C_LOC( DstInputData%xdotForce( i1_l ) ) + DstInputData%C_obj%xdotForce_Len = SIZE(DstInputData%xdotForce) + IF (DstInputData%C_obj%xdotForce_Len > 0) & + DstInputData%C_obj%xdotForce = C_LOC( DstInputData%xdotForce( i1_l ) ) END IF DstInputData%xdotForce = SrcInputData%xdotForce ENDIF @@ -2292,9 +2251,9 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ydotForce.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%ydotForce_Len = SIZE(DstInputData%ydotForce) - IF (DstInputData%c_obj%ydotForce_Len > 0) & - DstInputData%c_obj%ydotForce = C_LOC( DstInputData%ydotForce( i1_l ) ) + DstInputData%C_obj%ydotForce_Len = SIZE(DstInputData%ydotForce) + IF (DstInputData%C_obj%ydotForce_Len > 0) & + DstInputData%C_obj%ydotForce = C_LOC( DstInputData%ydotForce( i1_l ) ) END IF DstInputData%ydotForce = SrcInputData%ydotForce ENDIF @@ -2307,9 +2266,9 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%zdotForce.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%zdotForce_Len = SIZE(DstInputData%zdotForce) - IF (DstInputData%c_obj%zdotForce_Len > 0) & - DstInputData%c_obj%zdotForce = C_LOC( DstInputData%zdotForce( i1_l ) ) + DstInputData%C_obj%zdotForce_Len = SIZE(DstInputData%zdotForce) + IF (DstInputData%C_obj%zdotForce_Len > 0) & + DstInputData%C_obj%zdotForce = C_LOC( DstInputData%zdotForce( i1_l ) ) END IF DstInputData%zdotForce = SrcInputData%zdotForce ENDIF @@ -2322,9 +2281,9 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pOrientation.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%pOrientation_Len = SIZE(DstInputData%pOrientation) - IF (DstInputData%c_obj%pOrientation_Len > 0) & - DstInputData%c_obj%pOrientation = C_LOC( DstInputData%pOrientation( i1_l ) ) + DstInputData%C_obj%pOrientation_Len = SIZE(DstInputData%pOrientation) + IF (DstInputData%C_obj%pOrientation_Len > 0) & + DstInputData%C_obj%pOrientation = C_LOC( DstInputData%pOrientation( i1_l ) ) END IF DstInputData%pOrientation = SrcInputData%pOrientation ENDIF @@ -2337,9 +2296,9 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%fx_Len = SIZE(DstInputData%fx) - IF (DstInputData%c_obj%fx_Len > 0) & - DstInputData%c_obj%fx = C_LOC( DstInputData%fx( i1_l ) ) + DstInputData%C_obj%fx_Len = SIZE(DstInputData%fx) + IF (DstInputData%C_obj%fx_Len > 0) & + DstInputData%C_obj%fx = C_LOC( DstInputData%fx( i1_l ) ) END IF DstInputData%fx = SrcInputData%fx ENDIF @@ -2352,9 +2311,9 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fy.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%fy_Len = SIZE(DstInputData%fy) - IF (DstInputData%c_obj%fy_Len > 0) & - DstInputData%c_obj%fy = C_LOC( DstInputData%fy( i1_l ) ) + DstInputData%C_obj%fy_Len = SIZE(DstInputData%fy) + IF (DstInputData%C_obj%fy_Len > 0) & + DstInputData%C_obj%fy = C_LOC( DstInputData%fy( i1_l ) ) END IF DstInputData%fy = SrcInputData%fy ENDIF @@ -2367,9 +2326,9 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fz.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%fz_Len = SIZE(DstInputData%fz) - IF (DstInputData%c_obj%fz_Len > 0) & - DstInputData%c_obj%fz = C_LOC( DstInputData%fz( i1_l ) ) + DstInputData%C_obj%fz_Len = SIZE(DstInputData%fz) + IF (DstInputData%C_obj%fz_Len > 0) & + DstInputData%C_obj%fz = C_LOC( DstInputData%fz( i1_l ) ) END IF DstInputData%fz = SrcInputData%fz ENDIF @@ -2382,9 +2341,9 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%momentx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%momentx_Len = SIZE(DstInputData%momentx) - IF (DstInputData%c_obj%momentx_Len > 0) & - DstInputData%c_obj%momentx = C_LOC( DstInputData%momentx( i1_l ) ) + DstInputData%C_obj%momentx_Len = SIZE(DstInputData%momentx) + IF (DstInputData%C_obj%momentx_Len > 0) & + DstInputData%C_obj%momentx = C_LOC( DstInputData%momentx( i1_l ) ) END IF DstInputData%momentx = SrcInputData%momentx ENDIF @@ -2397,9 +2356,9 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%momenty.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%momenty_Len = SIZE(DstInputData%momenty) - IF (DstInputData%c_obj%momenty_Len > 0) & - DstInputData%c_obj%momenty = C_LOC( DstInputData%momenty( i1_l ) ) + DstInputData%C_obj%momenty_Len = SIZE(DstInputData%momenty) + IF (DstInputData%C_obj%momenty_Len > 0) & + DstInputData%C_obj%momenty = C_LOC( DstInputData%momenty( i1_l ) ) END IF DstInputData%momenty = SrcInputData%momenty ENDIF @@ -2412,9 +2371,9 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%momentz.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%momentz_Len = SIZE(DstInputData%momentz) - IF (DstInputData%c_obj%momentz_Len > 0) & - DstInputData%c_obj%momentz = C_LOC( DstInputData%momentz( i1_l ) ) + DstInputData%C_obj%momentz_Len = SIZE(DstInputData%momentz) + IF (DstInputData%C_obj%momentz_Len > 0) & + DstInputData%C_obj%momentz = C_LOC( DstInputData%momentz( i1_l ) ) END IF DstInputData%momentz = SrcInputData%momentz ENDIF @@ -2427,22 +2386,20 @@ SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%forceNodesChord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%forceNodesChord_Len = SIZE(DstInputData%forceNodesChord) - IF (DstInputData%c_obj%forceNodesChord_Len > 0) & - DstInputData%c_obj%forceNodesChord = C_LOC( DstInputData%forceNodesChord( i1_l ) ) + DstInputData%C_obj%forceNodesChord_Len = SIZE(DstInputData%forceNodesChord) + IF (DstInputData%C_obj%forceNodesChord_Len > 0) & + DstInputData%C_obj%forceNodesChord = C_LOC( DstInputData%forceNodesChord( i1_l ) ) END IF DstInputData%forceNodesChord = SrcInputData%forceNodesChord ENDIF END SUBROUTINE OpFM_CopyInput - SUBROUTINE OpFM_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE OpFM_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(OpFM_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyInput' @@ -2450,128 +2407,88 @@ SUBROUTINE OpFM_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ASSOCIATED(InputData%pxVel)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%pxVel) - InputData%pxVel => NULL() InputData%C_obj%pxVel = C_NULL_PTR InputData%C_obj%pxVel_Len = 0 ENDIF IF (ASSOCIATED(InputData%pyVel)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%pyVel) - InputData%pyVel => NULL() InputData%C_obj%pyVel = C_NULL_PTR InputData%C_obj%pyVel_Len = 0 ENDIF IF (ASSOCIATED(InputData%pzVel)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%pzVel) - InputData%pzVel => NULL() InputData%C_obj%pzVel = C_NULL_PTR InputData%C_obj%pzVel_Len = 0 ENDIF IF (ASSOCIATED(InputData%pxForce)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%pxForce) - InputData%pxForce => NULL() InputData%C_obj%pxForce = C_NULL_PTR InputData%C_obj%pxForce_Len = 0 ENDIF IF (ASSOCIATED(InputData%pyForce)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%pyForce) - InputData%pyForce => NULL() InputData%C_obj%pyForce = C_NULL_PTR InputData%C_obj%pyForce_Len = 0 ENDIF IF (ASSOCIATED(InputData%pzForce)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%pzForce) - InputData%pzForce => NULL() InputData%C_obj%pzForce = C_NULL_PTR InputData%C_obj%pzForce_Len = 0 ENDIF IF (ASSOCIATED(InputData%xdotForce)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%xdotForce) - InputData%xdotForce => NULL() InputData%C_obj%xdotForce = C_NULL_PTR InputData%C_obj%xdotForce_Len = 0 ENDIF IF (ASSOCIATED(InputData%ydotForce)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%ydotForce) - InputData%ydotForce => NULL() InputData%C_obj%ydotForce = C_NULL_PTR InputData%C_obj%ydotForce_Len = 0 ENDIF IF (ASSOCIATED(InputData%zdotForce)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%zdotForce) - InputData%zdotForce => NULL() InputData%C_obj%zdotForce = C_NULL_PTR InputData%C_obj%zdotForce_Len = 0 ENDIF IF (ASSOCIATED(InputData%pOrientation)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%pOrientation) - InputData%pOrientation => NULL() InputData%C_obj%pOrientation = C_NULL_PTR InputData%C_obj%pOrientation_Len = 0 ENDIF IF (ASSOCIATED(InputData%fx)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%fx) - InputData%fx => NULL() InputData%C_obj%fx = C_NULL_PTR InputData%C_obj%fx_Len = 0 ENDIF IF (ASSOCIATED(InputData%fy)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%fy) - InputData%fy => NULL() InputData%C_obj%fy = C_NULL_PTR InputData%C_obj%fy_Len = 0 ENDIF IF (ASSOCIATED(InputData%fz)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%fz) - InputData%fz => NULL() InputData%C_obj%fz = C_NULL_PTR InputData%C_obj%fz_Len = 0 ENDIF IF (ASSOCIATED(InputData%momentx)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%momentx) - InputData%momentx => NULL() InputData%C_obj%momentx = C_NULL_PTR InputData%C_obj%momentx_Len = 0 ENDIF IF (ASSOCIATED(InputData%momenty)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%momenty) - InputData%momenty => NULL() InputData%C_obj%momenty = C_NULL_PTR InputData%C_obj%momenty_Len = 0 ENDIF IF (ASSOCIATED(InputData%momentz)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%momentz) - InputData%momentz => NULL() InputData%C_obj%momentz = C_NULL_PTR InputData%C_obj%momentz_Len = 0 ENDIF IF (ASSOCIATED(InputData%forceNodesChord)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%forceNodesChord) - InputData%forceNodesChord => NULL() InputData%C_obj%forceNodesChord = C_NULL_PTR InputData%C_obj%forceNodesChord_Len = 0 ENDIF @@ -3023,9 +2940,9 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxVel.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%pxVel_Len = SIZE(OutData%pxVel) - IF (OutData%c_obj%pxVel_Len > 0) & - OutData%c_obj%pxVel = C_LOC( OutData%pxVel( i1_l ) ) + OutData%C_obj%pxVel_Len = SIZE(OutData%pxVel) + IF (OutData%C_obj%pxVel_Len > 0) & + OutData%C_obj%pxVel = C_LOC( OutData%pxVel( i1_l ) ) DO i1 = LBOUND(OutData%pxVel,1), UBOUND(OutData%pxVel,1) OutData%pxVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -3044,9 +2961,9 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pyVel.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%pyVel_Len = SIZE(OutData%pyVel) - IF (OutData%c_obj%pyVel_Len > 0) & - OutData%c_obj%pyVel = C_LOC( OutData%pyVel( i1_l ) ) + OutData%C_obj%pyVel_Len = SIZE(OutData%pyVel) + IF (OutData%C_obj%pyVel_Len > 0) & + OutData%C_obj%pyVel = C_LOC( OutData%pyVel( i1_l ) ) DO i1 = LBOUND(OutData%pyVel,1), UBOUND(OutData%pyVel,1) OutData%pyVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -3065,9 +2982,9 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzVel.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%pzVel_Len = SIZE(OutData%pzVel) - IF (OutData%c_obj%pzVel_Len > 0) & - OutData%c_obj%pzVel = C_LOC( OutData%pzVel( i1_l ) ) + OutData%C_obj%pzVel_Len = SIZE(OutData%pzVel) + IF (OutData%C_obj%pzVel_Len > 0) & + OutData%C_obj%pzVel = C_LOC( OutData%pzVel( i1_l ) ) DO i1 = LBOUND(OutData%pzVel,1), UBOUND(OutData%pzVel,1) OutData%pzVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -3086,9 +3003,9 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxForce.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%pxForce_Len = SIZE(OutData%pxForce) - IF (OutData%c_obj%pxForce_Len > 0) & - OutData%c_obj%pxForce = C_LOC( OutData%pxForce( i1_l ) ) + OutData%C_obj%pxForce_Len = SIZE(OutData%pxForce) + IF (OutData%C_obj%pxForce_Len > 0) & + OutData%C_obj%pxForce = C_LOC( OutData%pxForce( i1_l ) ) DO i1 = LBOUND(OutData%pxForce,1), UBOUND(OutData%pxForce,1) OutData%pxForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -3107,9 +3024,9 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pyForce.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%pyForce_Len = SIZE(OutData%pyForce) - IF (OutData%c_obj%pyForce_Len > 0) & - OutData%c_obj%pyForce = C_LOC( OutData%pyForce( i1_l ) ) + OutData%C_obj%pyForce_Len = SIZE(OutData%pyForce) + IF (OutData%C_obj%pyForce_Len > 0) & + OutData%C_obj%pyForce = C_LOC( OutData%pyForce( i1_l ) ) DO i1 = LBOUND(OutData%pyForce,1), UBOUND(OutData%pyForce,1) OutData%pyForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -3128,9 +3045,9 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzForce.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%pzForce_Len = SIZE(OutData%pzForce) - IF (OutData%c_obj%pzForce_Len > 0) & - OutData%c_obj%pzForce = C_LOC( OutData%pzForce( i1_l ) ) + OutData%C_obj%pzForce_Len = SIZE(OutData%pzForce) + IF (OutData%C_obj%pzForce_Len > 0) & + OutData%C_obj%pzForce = C_LOC( OutData%pzForce( i1_l ) ) DO i1 = LBOUND(OutData%pzForce,1), UBOUND(OutData%pzForce,1) OutData%pzForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -3149,9 +3066,9 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdotForce.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%xdotForce_Len = SIZE(OutData%xdotForce) - IF (OutData%c_obj%xdotForce_Len > 0) & - OutData%c_obj%xdotForce = C_LOC( OutData%xdotForce( i1_l ) ) + OutData%C_obj%xdotForce_Len = SIZE(OutData%xdotForce) + IF (OutData%C_obj%xdotForce_Len > 0) & + OutData%C_obj%xdotForce = C_LOC( OutData%xdotForce( i1_l ) ) DO i1 = LBOUND(OutData%xdotForce,1), UBOUND(OutData%xdotForce,1) OutData%xdotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -3170,9 +3087,9 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ydotForce.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%ydotForce_Len = SIZE(OutData%ydotForce) - IF (OutData%c_obj%ydotForce_Len > 0) & - OutData%c_obj%ydotForce = C_LOC( OutData%ydotForce( i1_l ) ) + OutData%C_obj%ydotForce_Len = SIZE(OutData%ydotForce) + IF (OutData%C_obj%ydotForce_Len > 0) & + OutData%C_obj%ydotForce = C_LOC( OutData%ydotForce( i1_l ) ) DO i1 = LBOUND(OutData%ydotForce,1), UBOUND(OutData%ydotForce,1) OutData%ydotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -3191,9 +3108,9 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zdotForce.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%zdotForce_Len = SIZE(OutData%zdotForce) - IF (OutData%c_obj%zdotForce_Len > 0) & - OutData%c_obj%zdotForce = C_LOC( OutData%zdotForce( i1_l ) ) + OutData%C_obj%zdotForce_Len = SIZE(OutData%zdotForce) + IF (OutData%C_obj%zdotForce_Len > 0) & + OutData%C_obj%zdotForce = C_LOC( OutData%zdotForce( i1_l ) ) DO i1 = LBOUND(OutData%zdotForce,1), UBOUND(OutData%zdotForce,1) OutData%zdotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -3212,9 +3129,9 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pOrientation.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%pOrientation_Len = SIZE(OutData%pOrientation) - IF (OutData%c_obj%pOrientation_Len > 0) & - OutData%c_obj%pOrientation = C_LOC( OutData%pOrientation( i1_l ) ) + OutData%C_obj%pOrientation_Len = SIZE(OutData%pOrientation) + IF (OutData%C_obj%pOrientation_Len > 0) & + OutData%C_obj%pOrientation = C_LOC( OutData%pOrientation( i1_l ) ) DO i1 = LBOUND(OutData%pOrientation,1), UBOUND(OutData%pOrientation,1) OutData%pOrientation(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -3233,9 +3150,9 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%fx_Len = SIZE(OutData%fx) - IF (OutData%c_obj%fx_Len > 0) & - OutData%c_obj%fx = C_LOC( OutData%fx( i1_l ) ) + OutData%C_obj%fx_Len = SIZE(OutData%fx) + IF (OutData%C_obj%fx_Len > 0) & + OutData%C_obj%fx = C_LOC( OutData%fx( i1_l ) ) DO i1 = LBOUND(OutData%fx,1), UBOUND(OutData%fx,1) OutData%fx(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -3254,9 +3171,9 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fy.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%fy_Len = SIZE(OutData%fy) - IF (OutData%c_obj%fy_Len > 0) & - OutData%c_obj%fy = C_LOC( OutData%fy( i1_l ) ) + OutData%C_obj%fy_Len = SIZE(OutData%fy) + IF (OutData%C_obj%fy_Len > 0) & + OutData%C_obj%fy = C_LOC( OutData%fy( i1_l ) ) DO i1 = LBOUND(OutData%fy,1), UBOUND(OutData%fy,1) OutData%fy(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -3275,9 +3192,9 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fz.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%fz_Len = SIZE(OutData%fz) - IF (OutData%c_obj%fz_Len > 0) & - OutData%c_obj%fz = C_LOC( OutData%fz( i1_l ) ) + OutData%C_obj%fz_Len = SIZE(OutData%fz) + IF (OutData%C_obj%fz_Len > 0) & + OutData%C_obj%fz = C_LOC( OutData%fz( i1_l ) ) DO i1 = LBOUND(OutData%fz,1), UBOUND(OutData%fz,1) OutData%fz(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -3296,9 +3213,9 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%momentx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%momentx_Len = SIZE(OutData%momentx) - IF (OutData%c_obj%momentx_Len > 0) & - OutData%c_obj%momentx = C_LOC( OutData%momentx( i1_l ) ) + OutData%C_obj%momentx_Len = SIZE(OutData%momentx) + IF (OutData%C_obj%momentx_Len > 0) & + OutData%C_obj%momentx = C_LOC( OutData%momentx( i1_l ) ) DO i1 = LBOUND(OutData%momentx,1), UBOUND(OutData%momentx,1) OutData%momentx(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -3317,9 +3234,9 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%momenty.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%momenty_Len = SIZE(OutData%momenty) - IF (OutData%c_obj%momenty_Len > 0) & - OutData%c_obj%momenty = C_LOC( OutData%momenty( i1_l ) ) + OutData%C_obj%momenty_Len = SIZE(OutData%momenty) + IF (OutData%C_obj%momenty_Len > 0) & + OutData%C_obj%momenty = C_LOC( OutData%momenty( i1_l ) ) DO i1 = LBOUND(OutData%momenty,1), UBOUND(OutData%momenty,1) OutData%momenty(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -3338,9 +3255,9 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%momentz.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%momentz_Len = SIZE(OutData%momentz) - IF (OutData%c_obj%momentz_Len > 0) & - OutData%c_obj%momentz = C_LOC( OutData%momentz( i1_l ) ) + OutData%C_obj%momentz_Len = SIZE(OutData%momentz) + IF (OutData%C_obj%momentz_Len > 0) & + OutData%C_obj%momentz = C_LOC( OutData%momentz( i1_l ) ) DO i1 = LBOUND(OutData%momentz,1), UBOUND(OutData%momentz,1) OutData%momentz(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -3359,9 +3276,9 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%forceNodesChord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%forceNodesChord_Len = SIZE(OutData%forceNodesChord) - IF (OutData%c_obj%forceNodesChord_Len > 0) & - OutData%c_obj%forceNodesChord = C_LOC( OutData%forceNodesChord( i1_l ) ) + OutData%C_obj%forceNodesChord_Len = SIZE(OutData%forceNodesChord) + IF (OutData%C_obj%forceNodesChord_Len > 0) & + OutData%C_obj%forceNodesChord = C_LOC( OutData%forceNodesChord( i1_l ) ) DO i1 = LBOUND(OutData%forceNodesChord,1), UBOUND(OutData%forceNodesChord,1) OutData%forceNodesChord(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -3558,204 +3475,204 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ! -- pxVel Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%pxVel)) THEN - InputData%c_obj%pxVel_Len = 0 - InputData%c_obj%pxVel = C_NULL_PTR + InputData%C_obj%pxVel_Len = 0 + InputData%C_obj%pxVel = C_NULL_PTR ELSE - InputData%c_obj%pxVel_Len = SIZE(InputData%pxVel) - IF (InputData%c_obj%pxVel_Len > 0) & - InputData%c_obj%pxVel = C_LOC( InputData%pxVel( LBOUND(InputData%pxVel,1) ) ) + InputData%C_obj%pxVel_Len = SIZE(InputData%pxVel) + IF (InputData%C_obj%pxVel_Len > 0) & + InputData%C_obj%pxVel = C_LOC( InputData%pxVel( LBOUND(InputData%pxVel,1) ) ) END IF END IF ! -- pyVel Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%pyVel)) THEN - InputData%c_obj%pyVel_Len = 0 - InputData%c_obj%pyVel = C_NULL_PTR + InputData%C_obj%pyVel_Len = 0 + InputData%C_obj%pyVel = C_NULL_PTR ELSE - InputData%c_obj%pyVel_Len = SIZE(InputData%pyVel) - IF (InputData%c_obj%pyVel_Len > 0) & - InputData%c_obj%pyVel = C_LOC( InputData%pyVel( LBOUND(InputData%pyVel,1) ) ) + InputData%C_obj%pyVel_Len = SIZE(InputData%pyVel) + IF (InputData%C_obj%pyVel_Len > 0) & + InputData%C_obj%pyVel = C_LOC( InputData%pyVel( LBOUND(InputData%pyVel,1) ) ) END IF END IF ! -- pzVel Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%pzVel)) THEN - InputData%c_obj%pzVel_Len = 0 - InputData%c_obj%pzVel = C_NULL_PTR + InputData%C_obj%pzVel_Len = 0 + InputData%C_obj%pzVel = C_NULL_PTR ELSE - InputData%c_obj%pzVel_Len = SIZE(InputData%pzVel) - IF (InputData%c_obj%pzVel_Len > 0) & - InputData%c_obj%pzVel = C_LOC( InputData%pzVel( LBOUND(InputData%pzVel,1) ) ) + InputData%C_obj%pzVel_Len = SIZE(InputData%pzVel) + IF (InputData%C_obj%pzVel_Len > 0) & + InputData%C_obj%pzVel = C_LOC( InputData%pzVel( LBOUND(InputData%pzVel,1) ) ) END IF END IF ! -- pxForce Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%pxForce)) THEN - InputData%c_obj%pxForce_Len = 0 - InputData%c_obj%pxForce = C_NULL_PTR + InputData%C_obj%pxForce_Len = 0 + InputData%C_obj%pxForce = C_NULL_PTR ELSE - InputData%c_obj%pxForce_Len = SIZE(InputData%pxForce) - IF (InputData%c_obj%pxForce_Len > 0) & - InputData%c_obj%pxForce = C_LOC( InputData%pxForce( LBOUND(InputData%pxForce,1) ) ) + InputData%C_obj%pxForce_Len = SIZE(InputData%pxForce) + IF (InputData%C_obj%pxForce_Len > 0) & + InputData%C_obj%pxForce = C_LOC( InputData%pxForce( LBOUND(InputData%pxForce,1) ) ) END IF END IF ! -- pyForce Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%pyForce)) THEN - InputData%c_obj%pyForce_Len = 0 - InputData%c_obj%pyForce = C_NULL_PTR + InputData%C_obj%pyForce_Len = 0 + InputData%C_obj%pyForce = C_NULL_PTR ELSE - InputData%c_obj%pyForce_Len = SIZE(InputData%pyForce) - IF (InputData%c_obj%pyForce_Len > 0) & - InputData%c_obj%pyForce = C_LOC( InputData%pyForce( LBOUND(InputData%pyForce,1) ) ) + InputData%C_obj%pyForce_Len = SIZE(InputData%pyForce) + IF (InputData%C_obj%pyForce_Len > 0) & + InputData%C_obj%pyForce = C_LOC( InputData%pyForce( LBOUND(InputData%pyForce,1) ) ) END IF END IF ! -- pzForce Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%pzForce)) THEN - InputData%c_obj%pzForce_Len = 0 - InputData%c_obj%pzForce = C_NULL_PTR + InputData%C_obj%pzForce_Len = 0 + InputData%C_obj%pzForce = C_NULL_PTR ELSE - InputData%c_obj%pzForce_Len = SIZE(InputData%pzForce) - IF (InputData%c_obj%pzForce_Len > 0) & - InputData%c_obj%pzForce = C_LOC( InputData%pzForce( LBOUND(InputData%pzForce,1) ) ) + InputData%C_obj%pzForce_Len = SIZE(InputData%pzForce) + IF (InputData%C_obj%pzForce_Len > 0) & + InputData%C_obj%pzForce = C_LOC( InputData%pzForce( LBOUND(InputData%pzForce,1) ) ) END IF END IF ! -- xdotForce Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%xdotForce)) THEN - InputData%c_obj%xdotForce_Len = 0 - InputData%c_obj%xdotForce = C_NULL_PTR + InputData%C_obj%xdotForce_Len = 0 + InputData%C_obj%xdotForce = C_NULL_PTR ELSE - InputData%c_obj%xdotForce_Len = SIZE(InputData%xdotForce) - IF (InputData%c_obj%xdotForce_Len > 0) & - InputData%c_obj%xdotForce = C_LOC( InputData%xdotForce( LBOUND(InputData%xdotForce,1) ) ) + InputData%C_obj%xdotForce_Len = SIZE(InputData%xdotForce) + IF (InputData%C_obj%xdotForce_Len > 0) & + InputData%C_obj%xdotForce = C_LOC( InputData%xdotForce( LBOUND(InputData%xdotForce,1) ) ) END IF END IF ! -- ydotForce Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%ydotForce)) THEN - InputData%c_obj%ydotForce_Len = 0 - InputData%c_obj%ydotForce = C_NULL_PTR + InputData%C_obj%ydotForce_Len = 0 + InputData%C_obj%ydotForce = C_NULL_PTR ELSE - InputData%c_obj%ydotForce_Len = SIZE(InputData%ydotForce) - IF (InputData%c_obj%ydotForce_Len > 0) & - InputData%c_obj%ydotForce = C_LOC( InputData%ydotForce( LBOUND(InputData%ydotForce,1) ) ) + InputData%C_obj%ydotForce_Len = SIZE(InputData%ydotForce) + IF (InputData%C_obj%ydotForce_Len > 0) & + InputData%C_obj%ydotForce = C_LOC( InputData%ydotForce( LBOUND(InputData%ydotForce,1) ) ) END IF END IF ! -- zdotForce Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%zdotForce)) THEN - InputData%c_obj%zdotForce_Len = 0 - InputData%c_obj%zdotForce = C_NULL_PTR + InputData%C_obj%zdotForce_Len = 0 + InputData%C_obj%zdotForce = C_NULL_PTR ELSE - InputData%c_obj%zdotForce_Len = SIZE(InputData%zdotForce) - IF (InputData%c_obj%zdotForce_Len > 0) & - InputData%c_obj%zdotForce = C_LOC( InputData%zdotForce( LBOUND(InputData%zdotForce,1) ) ) + InputData%C_obj%zdotForce_Len = SIZE(InputData%zdotForce) + IF (InputData%C_obj%zdotForce_Len > 0) & + InputData%C_obj%zdotForce = C_LOC( InputData%zdotForce( LBOUND(InputData%zdotForce,1) ) ) END IF END IF ! -- pOrientation Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%pOrientation)) THEN - InputData%c_obj%pOrientation_Len = 0 - InputData%c_obj%pOrientation = C_NULL_PTR + InputData%C_obj%pOrientation_Len = 0 + InputData%C_obj%pOrientation = C_NULL_PTR ELSE - InputData%c_obj%pOrientation_Len = SIZE(InputData%pOrientation) - IF (InputData%c_obj%pOrientation_Len > 0) & - InputData%c_obj%pOrientation = C_LOC( InputData%pOrientation( LBOUND(InputData%pOrientation,1) ) ) + InputData%C_obj%pOrientation_Len = SIZE(InputData%pOrientation) + IF (InputData%C_obj%pOrientation_Len > 0) & + InputData%C_obj%pOrientation = C_LOC( InputData%pOrientation( LBOUND(InputData%pOrientation,1) ) ) END IF END IF ! -- fx Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%fx)) THEN - InputData%c_obj%fx_Len = 0 - InputData%c_obj%fx = C_NULL_PTR + InputData%C_obj%fx_Len = 0 + InputData%C_obj%fx = C_NULL_PTR ELSE - InputData%c_obj%fx_Len = SIZE(InputData%fx) - IF (InputData%c_obj%fx_Len > 0) & - InputData%c_obj%fx = C_LOC( InputData%fx( LBOUND(InputData%fx,1) ) ) + InputData%C_obj%fx_Len = SIZE(InputData%fx) + IF (InputData%C_obj%fx_Len > 0) & + InputData%C_obj%fx = C_LOC( InputData%fx( LBOUND(InputData%fx,1) ) ) END IF END IF ! -- fy Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%fy)) THEN - InputData%c_obj%fy_Len = 0 - InputData%c_obj%fy = C_NULL_PTR + InputData%C_obj%fy_Len = 0 + InputData%C_obj%fy = C_NULL_PTR ELSE - InputData%c_obj%fy_Len = SIZE(InputData%fy) - IF (InputData%c_obj%fy_Len > 0) & - InputData%c_obj%fy = C_LOC( InputData%fy( LBOUND(InputData%fy,1) ) ) + InputData%C_obj%fy_Len = SIZE(InputData%fy) + IF (InputData%C_obj%fy_Len > 0) & + InputData%C_obj%fy = C_LOC( InputData%fy( LBOUND(InputData%fy,1) ) ) END IF END IF ! -- fz Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%fz)) THEN - InputData%c_obj%fz_Len = 0 - InputData%c_obj%fz = C_NULL_PTR + InputData%C_obj%fz_Len = 0 + InputData%C_obj%fz = C_NULL_PTR ELSE - InputData%c_obj%fz_Len = SIZE(InputData%fz) - IF (InputData%c_obj%fz_Len > 0) & - InputData%c_obj%fz = C_LOC( InputData%fz( LBOUND(InputData%fz,1) ) ) + InputData%C_obj%fz_Len = SIZE(InputData%fz) + IF (InputData%C_obj%fz_Len > 0) & + InputData%C_obj%fz = C_LOC( InputData%fz( LBOUND(InputData%fz,1) ) ) END IF END IF ! -- momentx Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%momentx)) THEN - InputData%c_obj%momentx_Len = 0 - InputData%c_obj%momentx = C_NULL_PTR + InputData%C_obj%momentx_Len = 0 + InputData%C_obj%momentx = C_NULL_PTR ELSE - InputData%c_obj%momentx_Len = SIZE(InputData%momentx) - IF (InputData%c_obj%momentx_Len > 0) & - InputData%c_obj%momentx = C_LOC( InputData%momentx( LBOUND(InputData%momentx,1) ) ) + InputData%C_obj%momentx_Len = SIZE(InputData%momentx) + IF (InputData%C_obj%momentx_Len > 0) & + InputData%C_obj%momentx = C_LOC( InputData%momentx( LBOUND(InputData%momentx,1) ) ) END IF END IF ! -- momenty Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%momenty)) THEN - InputData%c_obj%momenty_Len = 0 - InputData%c_obj%momenty = C_NULL_PTR + InputData%C_obj%momenty_Len = 0 + InputData%C_obj%momenty = C_NULL_PTR ELSE - InputData%c_obj%momenty_Len = SIZE(InputData%momenty) - IF (InputData%c_obj%momenty_Len > 0) & - InputData%c_obj%momenty = C_LOC( InputData%momenty( LBOUND(InputData%momenty,1) ) ) + InputData%C_obj%momenty_Len = SIZE(InputData%momenty) + IF (InputData%C_obj%momenty_Len > 0) & + InputData%C_obj%momenty = C_LOC( InputData%momenty( LBOUND(InputData%momenty,1) ) ) END IF END IF ! -- momentz Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%momentz)) THEN - InputData%c_obj%momentz_Len = 0 - InputData%c_obj%momentz = C_NULL_PTR + InputData%C_obj%momentz_Len = 0 + InputData%C_obj%momentz = C_NULL_PTR ELSE - InputData%c_obj%momentz_Len = SIZE(InputData%momentz) - IF (InputData%c_obj%momentz_Len > 0) & - InputData%c_obj%momentz = C_LOC( InputData%momentz( LBOUND(InputData%momentz,1) ) ) + InputData%C_obj%momentz_Len = SIZE(InputData%momentz) + IF (InputData%C_obj%momentz_Len > 0) & + InputData%C_obj%momentz = C_LOC( InputData%momentz( LBOUND(InputData%momentz,1) ) ) END IF END IF ! -- forceNodesChord Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%forceNodesChord)) THEN - InputData%c_obj%forceNodesChord_Len = 0 - InputData%c_obj%forceNodesChord = C_NULL_PTR + InputData%C_obj%forceNodesChord_Len = 0 + InputData%C_obj%forceNodesChord = C_NULL_PTR ELSE - InputData%c_obj%forceNodesChord_Len = SIZE(InputData%forceNodesChord) - IF (InputData%c_obj%forceNodesChord_Len > 0) & - InputData%c_obj%forceNodesChord = C_LOC( InputData%forceNodesChord( LBOUND(InputData%forceNodesChord,1) ) ) + InputData%C_obj%forceNodesChord_Len = SIZE(InputData%forceNodesChord) + IF (InputData%C_obj%forceNodesChord_Len > 0) & + InputData%C_obj%forceNodesChord = C_LOC( InputData%forceNodesChord( LBOUND(InputData%forceNodesChord,1) ) ) END IF END IF END SUBROUTINE OpFM_F2C_CopyInput @@ -3784,9 +3701,9 @@ SUBROUTINE OpFM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOutputData%c_obj%u_Len = SIZE(DstOutputData%u) - IF (DstOutputData%c_obj%u_Len > 0) & - DstOutputData%c_obj%u = C_LOC( DstOutputData%u( i1_l ) ) + DstOutputData%C_obj%u_Len = SIZE(DstOutputData%u) + IF (DstOutputData%C_obj%u_Len > 0) & + DstOutputData%C_obj%u = C_LOC( DstOutputData%u( i1_l ) ) END IF DstOutputData%u = SrcOutputData%u ENDIF @@ -3799,9 +3716,9 @@ SUBROUTINE OpFM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%v.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOutputData%c_obj%v_Len = SIZE(DstOutputData%v) - IF (DstOutputData%c_obj%v_Len > 0) & - DstOutputData%c_obj%v = C_LOC( DstOutputData%v( i1_l ) ) + DstOutputData%C_obj%v_Len = SIZE(DstOutputData%v) + IF (DstOutputData%C_obj%v_Len > 0) & + DstOutputData%C_obj%v = C_LOC( DstOutputData%v( i1_l ) ) END IF DstOutputData%v = SrcOutputData%v ENDIF @@ -3814,9 +3731,9 @@ SUBROUTINE OpFM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%w.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOutputData%c_obj%w_Len = SIZE(DstOutputData%w) - IF (DstOutputData%c_obj%w_Len > 0) & - DstOutputData%c_obj%w = C_LOC( DstOutputData%w( i1_l ) ) + DstOutputData%C_obj%w_Len = SIZE(DstOutputData%w) + IF (DstOutputData%C_obj%w_Len > 0) & + DstOutputData%C_obj%w = C_LOC( DstOutputData%w( i1_l ) ) END IF DstOutputData%w = SrcOutputData%w ENDIF @@ -3834,14 +3751,12 @@ SUBROUTINE OpFM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err ENDIF END SUBROUTINE OpFM_CopyOutput - SUBROUTINE OpFM_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE OpFM_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyOutput' @@ -3849,30 +3764,18 @@ SUBROUTINE OpFM_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ASSOCIATED(OutputData%u)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OutputData%u) - OutputData%u => NULL() OutputData%C_obj%u = C_NULL_PTR OutputData%C_obj%u_Len = 0 ENDIF IF (ASSOCIATED(OutputData%v)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OutputData%v) - OutputData%v => NULL() OutputData%C_obj%v = C_NULL_PTR OutputData%C_obj%v_Len = 0 ENDIF IF (ASSOCIATED(OutputData%w)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OutputData%w) - OutputData%w => NULL() OutputData%C_obj%w = C_NULL_PTR OutputData%C_obj%w_Len = 0 ENDIF @@ -4067,9 +3970,9 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%u_Len = SIZE(OutData%u) - IF (OutData%c_obj%u_Len > 0) & - OutData%c_obj%u = C_LOC( OutData%u( i1_l ) ) + OutData%C_obj%u_Len = SIZE(OutData%u) + IF (OutData%C_obj%u_Len > 0) & + OutData%C_obj%u = C_LOC( OutData%u( i1_l ) ) DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) OutData%u(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -4088,9 +3991,9 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%v.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%v_Len = SIZE(OutData%v) - IF (OutData%c_obj%v_Len > 0) & - OutData%c_obj%v = C_LOC( OutData%v( i1_l ) ) + OutData%C_obj%v_Len = SIZE(OutData%v) + IF (OutData%C_obj%v_Len > 0) & + OutData%C_obj%v = C_LOC( OutData%v( i1_l ) ) DO i1 = LBOUND(OutData%v,1), UBOUND(OutData%v,1) OutData%v(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -4109,9 +4012,9 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%w.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%w_Len = SIZE(OutData%w) - IF (OutData%c_obj%w_Len > 0) & - OutData%c_obj%w = C_LOC( OutData%w( i1_l ) ) + OutData%C_obj%w_Len = SIZE(OutData%w) + IF (OutData%C_obj%w_Len > 0) & + OutData%C_obj%w = C_LOC( OutData%w( i1_l ) ) DO i1 = LBOUND(OutData%w,1), UBOUND(OutData%w,1) OutData%w(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -4200,36 +4103,36 @@ SUBROUTINE OpFM_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ! -- u Output Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OutputData%u)) THEN - OutputData%c_obj%u_Len = 0 - OutputData%c_obj%u = C_NULL_PTR + OutputData%C_obj%u_Len = 0 + OutputData%C_obj%u = C_NULL_PTR ELSE - OutputData%c_obj%u_Len = SIZE(OutputData%u) - IF (OutputData%c_obj%u_Len > 0) & - OutputData%c_obj%u = C_LOC( OutputData%u( LBOUND(OutputData%u,1) ) ) + OutputData%C_obj%u_Len = SIZE(OutputData%u) + IF (OutputData%C_obj%u_Len > 0) & + OutputData%C_obj%u = C_LOC( OutputData%u( LBOUND(OutputData%u,1) ) ) END IF END IF ! -- v Output Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OutputData%v)) THEN - OutputData%c_obj%v_Len = 0 - OutputData%c_obj%v = C_NULL_PTR + OutputData%C_obj%v_Len = 0 + OutputData%C_obj%v = C_NULL_PTR ELSE - OutputData%c_obj%v_Len = SIZE(OutputData%v) - IF (OutputData%c_obj%v_Len > 0) & - OutputData%c_obj%v = C_LOC( OutputData%v( LBOUND(OutputData%v,1) ) ) + OutputData%C_obj%v_Len = SIZE(OutputData%v) + IF (OutputData%C_obj%v_Len > 0) & + OutputData%C_obj%v = C_LOC( OutputData%v( LBOUND(OutputData%v,1) ) ) END IF END IF ! -- w Output Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OutputData%w)) THEN - OutputData%c_obj%w_Len = 0 - OutputData%c_obj%w = C_NULL_PTR + OutputData%C_obj%w_Len = 0 + OutputData%C_obj%w = C_NULL_PTR ELSE - OutputData%c_obj%w_Len = SIZE(OutputData%w) - IF (OutputData%c_obj%w_Len > 0) & - OutputData%c_obj%w = C_LOC( OutputData%w( LBOUND(OutputData%w,1) ) ) + OutputData%C_obj%w_Len = SIZE(OutputData%w) + IF (OutputData%C_obj%w_Len > 0) & + OutputData%C_obj%w = C_LOC( OutputData%w( LBOUND(OutputData%w,1) ) ) END IF END IF END SUBROUTINE OpFM_F2C_CopyOutput diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 69d3c7a6ee..17ffff59f8 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -115,8 +115,6 @@ SUBROUTINE Orca_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyInitInput' @@ -128,14 +126,12 @@ SUBROUTINE Orca_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%TMax = SrcInitInputData%TMax END SUBROUTINE Orca_CopyInitInput - SUBROUTINE Orca_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Orca_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(Orca_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInitInput' @@ -143,12 +139,6 @@ SUBROUTINE Orca_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Orca_DestroyInitInput SUBROUTINE Orca_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -241,8 +231,6 @@ SUBROUTINE Orca_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackInitInput' @@ -312,14 +300,12 @@ SUBROUTINE Orca_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ENDIF END SUBROUTINE Orca_CopyInitOutput - SUBROUTINE Orca_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Orca_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(Orca_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInitOutput' @@ -327,13 +313,7 @@ SUBROUTINE Orca_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) @@ -380,7 +360,7 @@ SUBROUTINE Orca_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -433,7 +413,7 @@ SUBROUTINE Orca_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -557,7 +537,7 @@ SUBROUTINE Orca_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -627,14 +607,12 @@ SUBROUTINE Orca_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%DirRoot = SrcInputFileData%DirRoot END SUBROUTINE Orca_CopyInputFile - SUBROUTINE Orca_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Orca_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) TYPE(Orca_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInputFile' @@ -642,12 +620,6 @@ SUBROUTINE Orca_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Orca_DestroyInputFile SUBROUTINE Orca_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -804,14 +776,12 @@ SUBROUTINE Orca_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState END SUBROUTINE Orca_CopyOtherState - SUBROUTINE Orca_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Orca_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(Orca_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyOtherState' @@ -819,12 +789,6 @@ SUBROUTINE Orca_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Orca_DestroyOtherState SUBROUTINE Orca_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -958,14 +922,12 @@ SUBROUTINE Orca_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%LastTimeStep = SrcMiscData%LastTimeStep END SUBROUTINE Orca_CopyMisc - SUBROUTINE Orca_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Orca_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(Orca_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyMisc' @@ -973,12 +935,6 @@ SUBROUTINE Orca_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MiscData%AllOuts)) THEN DEALLOCATE(MiscData%AllOuts) ENDIF @@ -1198,14 +1154,12 @@ SUBROUTINE Orca_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE Orca_CopyParam - SUBROUTINE Orca_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Orca_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(Orca_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyParam' @@ -1213,17 +1167,11 @@ SUBROUTINE Orca_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL FreeDynamicLib( ParamData%DLL_Orca, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) @@ -1292,7 +1240,7 @@ SUBROUTINE Orca_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1386,7 +1334,7 @@ SUBROUTINE Orca_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1542,7 +1490,7 @@ SUBROUTINE Orca_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1572,14 +1520,12 @@ SUBROUTINE Orca_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE Orca_CopyInput - SUBROUTINE Orca_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Orca_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(Orca_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInput' @@ -1587,12 +1533,6 @@ SUBROUTINE Orca_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( InputData%PtfmMesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Orca_DestroyInput @@ -1807,14 +1747,12 @@ SUBROUTINE Orca_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err ENDIF END SUBROUTINE Orca_CopyOutput - SUBROUTINE Orca_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Orca_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(Orca_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyOutput' @@ -1822,12 +1760,6 @@ SUBROUTINE Orca_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( OutputData%PtfmMesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(OutputData%WriteOutput)) THEN @@ -2069,14 +2001,12 @@ SUBROUTINE Orca_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Err DstContStateData%Dummy = SrcContStateData%Dummy END SUBROUTINE Orca_CopyContState - SUBROUTINE Orca_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Orca_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(Orca_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyContState' @@ -2084,12 +2014,6 @@ SUBROUTINE Orca_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Orca_DestroyContState SUBROUTINE Orca_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2206,14 +2130,12 @@ SUBROUTINE Orca_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Err DstDiscStateData%Dummy = SrcDiscStateData%Dummy END SUBROUTINE Orca_CopyDiscState - SUBROUTINE Orca_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Orca_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(Orca_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyDiscState' @@ -2221,12 +2143,6 @@ SUBROUTINE Orca_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Orca_DestroyDiscState SUBROUTINE Orca_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2343,14 +2259,12 @@ SUBROUTINE Orca_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCod DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE Orca_CopyConstrState - SUBROUTINE Orca_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Orca_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(Orca_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyConstrState' @@ -2358,12 +2272,6 @@ SUBROUTINE Orca_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Orca_DestroyConstrState SUBROUTINE Orca_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) diff --git a/modules/seastate/src/Current_Types.f90 b/modules/seastate/src/Current_Types.f90 index fcd9c9f9fd..060b993dfc 100644 --- a/modules/seastate/src/Current_Types.f90 +++ b/modules/seastate/src/Current_Types.f90 @@ -100,14 +100,12 @@ SUBROUTINE Current_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%DirRoot = SrcInitInputData%DirRoot END SUBROUTINE Current_CopyInitInput - SUBROUTINE Current_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Current_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(Current_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyInitInput' @@ -115,12 +113,6 @@ SUBROUTINE Current_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%WaveKinGridzi)) THEN DEALLOCATE(InitInputData%WaveKinGridzi) ENDIF @@ -368,14 +360,12 @@ SUBROUTINE Current_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCod DstInitOutputData%PCurrVyiPz0 = SrcInitOutputData%PCurrVyiPz0 END SUBROUTINE Current_CopyInitOutput - SUBROUTINE Current_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Current_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(Current_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyInitOutput' @@ -383,12 +373,6 @@ SUBROUTINE Current_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCAT ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%CurrVxi)) THEN DEALLOCATE(InitOutputData%CurrVxi) ENDIF diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 221053f234..4059ea861a 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -73,198 +73,17 @@ SUBROUTINE SeaSt_WaveField_CopySeaSt_WaveFieldType( SrcSeaSt_WaveFieldTypeData, ! ErrStat = ErrID_None ErrMsg = "" -IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%WaveTime)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveTime,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveTime,1) - IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%WaveTime)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%WaveTime = SrcSeaSt_WaveFieldTypeData%WaveTime -ENDIF -IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%WaveDynP)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,3) - i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,4) - i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,4) - IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%WaveDynP)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%WaveDynP = SrcSeaSt_WaveFieldTypeData%WaveDynP -ENDIF -IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%WaveAcc)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,3) - i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,4) - i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,4) - i5_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,5) - i5_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,5) - IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%WaveAcc)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%WaveAcc = SrcSeaSt_WaveFieldTypeData%WaveAcc -ENDIF -IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%WaveAccMCF)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,3) - i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,4) - i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,4) - i5_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,5) - i5_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,5) - IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%WaveAccMCF)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%WaveAccMCF = SrcSeaSt_WaveFieldTypeData%WaveAccMCF -ENDIF -IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%WaveVel)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,3) - i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,4) - i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,4) - i5_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,5) - i5_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,5) - IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%WaveVel)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%WaveVel = SrcSeaSt_WaveFieldTypeData%WaveVel -ENDIF -IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%PWaveDynP0)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,3) - IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%PWaveDynP0)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%PWaveDynP0 = SrcSeaSt_WaveFieldTypeData%PWaveDynP0 -ENDIF -IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%PWaveAcc0)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,3) - i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,4) - i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,4) - IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%PWaveAcc0)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%PWaveAcc0 = SrcSeaSt_WaveFieldTypeData%PWaveAcc0 -ENDIF -IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,3) - i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,4) - i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,4) - IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%PWaveAccMCF0 = SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0 -ENDIF -IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%PWaveVel0)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,3) - i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,4) - i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,4) - IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%PWaveVel0)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%PWaveVel0 = SrcSeaSt_WaveFieldTypeData%PWaveVel0 -ENDIF -IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%WaveElev1)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,3) - IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%WaveElev1)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%WaveElev1 = SrcSeaSt_WaveFieldTypeData%WaveElev1 -ENDIF -IF (ASSOCIATED(SrcSeaSt_WaveFieldTypeData%WaveElev2)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,3) - IF (.NOT. ASSOCIATED(DstSeaSt_WaveFieldTypeData%WaveElev2)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%WaveElev2 = SrcSeaSt_WaveFieldTypeData%WaveElev2 -ENDIF + DstSeaSt_WaveFieldTypeData%WaveTime => SrcSeaSt_WaveFieldTypeData%WaveTime + DstSeaSt_WaveFieldTypeData%WaveDynP => SrcSeaSt_WaveFieldTypeData%WaveDynP + DstSeaSt_WaveFieldTypeData%WaveAcc => SrcSeaSt_WaveFieldTypeData%WaveAcc + DstSeaSt_WaveFieldTypeData%WaveAccMCF => SrcSeaSt_WaveFieldTypeData%WaveAccMCF + DstSeaSt_WaveFieldTypeData%WaveVel => SrcSeaSt_WaveFieldTypeData%WaveVel + DstSeaSt_WaveFieldTypeData%PWaveDynP0 => SrcSeaSt_WaveFieldTypeData%PWaveDynP0 + DstSeaSt_WaveFieldTypeData%PWaveAcc0 => SrcSeaSt_WaveFieldTypeData%PWaveAcc0 + DstSeaSt_WaveFieldTypeData%PWaveAccMCF0 => SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0 + DstSeaSt_WaveFieldTypeData%PWaveVel0 => SrcSeaSt_WaveFieldTypeData%PWaveVel0 + DstSeaSt_WaveFieldTypeData%WaveElev1 => SrcSeaSt_WaveFieldTypeData%WaveElev1 + DstSeaSt_WaveFieldTypeData%WaveElev2 => SrcSeaSt_WaveFieldTypeData%WaveElev2 CALL SeaSt_Interp_CopyParam( SrcSeaSt_WaveFieldTypeData%SeaSt_Interp_p, DstSeaSt_WaveFieldTypeData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN @@ -273,14 +92,12 @@ SUBROUTINE SeaSt_WaveField_CopySeaSt_WaveFieldType( SrcSeaSt_WaveFieldTypeData, DstSeaSt_WaveFieldTypeData%MSL2SWL = SrcSeaSt_WaveFieldTypeData%MSL2SWL END SUBROUTINE SeaSt_WaveField_CopySeaSt_WaveFieldType - SUBROUTINE SeaSt_WaveField_DestroySeaSt_WaveFieldType( SeaSt_WaveFieldTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SeaSt_WaveField_DestroySeaSt_WaveFieldType( SeaSt_WaveFieldTypeData, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: SeaSt_WaveFieldTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_WaveField_DestroySeaSt_WaveFieldType' @@ -288,68 +105,18 @@ SUBROUTINE SeaSt_WaveField_DestroySeaSt_WaveFieldType( SeaSt_WaveFieldTypeData, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ASSOCIATED(SeaSt_WaveFieldTypeData%WaveTime)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveTime) - SeaSt_WaveFieldTypeData%WaveTime => NULL() -ENDIF -IF (ASSOCIATED(SeaSt_WaveFieldTypeData%WaveDynP)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveDynP) - SeaSt_WaveFieldTypeData%WaveDynP => NULL() -ENDIF -IF (ASSOCIATED(SeaSt_WaveFieldTypeData%WaveAcc)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveAcc) - SeaSt_WaveFieldTypeData%WaveAcc => NULL() -ENDIF -IF (ASSOCIATED(SeaSt_WaveFieldTypeData%WaveAccMCF)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveAccMCF) - SeaSt_WaveFieldTypeData%WaveAccMCF => NULL() -ENDIF -IF (ASSOCIATED(SeaSt_WaveFieldTypeData%WaveVel)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveVel) - SeaSt_WaveFieldTypeData%WaveVel => NULL() -ENDIF -IF (ASSOCIATED(SeaSt_WaveFieldTypeData%PWaveDynP0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(SeaSt_WaveFieldTypeData%PWaveDynP0) - SeaSt_WaveFieldTypeData%PWaveDynP0 => NULL() -ENDIF -IF (ASSOCIATED(SeaSt_WaveFieldTypeData%PWaveAcc0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(SeaSt_WaveFieldTypeData%PWaveAcc0) - SeaSt_WaveFieldTypeData%PWaveAcc0 => NULL() -ENDIF -IF (ASSOCIATED(SeaSt_WaveFieldTypeData%PWaveAccMCF0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(SeaSt_WaveFieldTypeData%PWaveAccMCF0) - SeaSt_WaveFieldTypeData%PWaveAccMCF0 => NULL() -ENDIF -IF (ASSOCIATED(SeaSt_WaveFieldTypeData%PWaveVel0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(SeaSt_WaveFieldTypeData%PWaveVel0) - SeaSt_WaveFieldTypeData%PWaveVel0 => NULL() -ENDIF -IF (ASSOCIATED(SeaSt_WaveFieldTypeData%WaveElev1)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveElev1) - SeaSt_WaveFieldTypeData%WaveElev1 => NULL() -ENDIF -IF (ASSOCIATED(SeaSt_WaveFieldTypeData%WaveElev2)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveElev2) - SeaSt_WaveFieldTypeData%WaveElev2 => NULL() -ENDIF - CALL SeaSt_Interp_DestroyParam( SeaSt_WaveFieldTypeData%SeaSt_Interp_p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +NULLIFY(SeaSt_WaveFieldTypeData%WaveTime) +NULLIFY(SeaSt_WaveFieldTypeData%WaveDynP) +NULLIFY(SeaSt_WaveFieldTypeData%WaveAcc) +NULLIFY(SeaSt_WaveFieldTypeData%WaveAccMCF) +NULLIFY(SeaSt_WaveFieldTypeData%WaveVel) +NULLIFY(SeaSt_WaveFieldTypeData%PWaveDynP0) +NULLIFY(SeaSt_WaveFieldTypeData%PWaveAcc0) +NULLIFY(SeaSt_WaveFieldTypeData%PWaveAccMCF0) +NULLIFY(SeaSt_WaveFieldTypeData%PWaveVel0) +NULLIFY(SeaSt_WaveFieldTypeData%WaveElev1) +NULLIFY(SeaSt_WaveFieldTypeData%WaveElev2) + CALL SeaSt_Interp_DestroyParam( SeaSt_WaveFieldTypeData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SeaSt_WaveField_DestroySeaSt_WaveFieldType @@ -388,61 +155,6 @@ SUBROUTINE SeaSt_WaveField_PackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ASSOCIATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP allocated yes/no - IF ( ASSOCIATED(InData%WaveDynP) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! WaveDynP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP) ! WaveDynP - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc allocated yes/no - IF ( ASSOCIATED(InData%WaveAcc) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveAcc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc) ! WaveAcc - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAccMCF allocated yes/no - IF ( ASSOCIATED(InData%WaveAccMCF) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveAccMCF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAccMCF) ! WaveAccMCF - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel allocated yes/no - IF ( ASSOCIATED(InData%WaveVel) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel) ! WaveVel - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveDynP0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveDynP0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PWaveDynP0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveDynP0) ! PWaveDynP0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveAcc0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveAcc0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveAcc0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveAcc0) ! PWaveAcc0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveAccMCF0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveAccMCF0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveAccMCF0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveAccMCF0) ! PWaveAccMCF0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveVel0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveVel0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveVel0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveVel0) ! PWaveVel0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev1 allocated yes/no - IF ( ASSOCIATED(InData%WaveElev1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElev1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev1) ! WaveElev1 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev2 allocated yes/no - IF ( ASSOCIATED(InData%WaveElev2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElev2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev2) ! WaveElev2 - END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_p: size of buffers for each call to pack subtype CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt_Interp_p @@ -491,321 +203,6 @@ SUBROUTINE SeaSt_WaveField_PackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Db_Xferred = 1 Int_Xferred = 1 - IF ( .NOT. ASSOCIATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveDynP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%WaveDynP,4), UBOUND(InData%WaveDynP,4) - DO i3 = LBOUND(InData%WaveDynP,3), UBOUND(InData%WaveDynP,3) - DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) - DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveAcc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveAcc,5), UBOUND(InData%WaveAcc,5) - DO i4 = LBOUND(InData%WaveAcc,4), UBOUND(InData%WaveAcc,4) - DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) - DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) - DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveAccMCF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveAccMCF,5), UBOUND(InData%WaveAccMCF,5) - DO i4 = LBOUND(InData%WaveAccMCF,4), UBOUND(InData%WaveAccMCF,4) - DO i3 = LBOUND(InData%WaveAccMCF,3), UBOUND(InData%WaveAccMCF,3) - DO i2 = LBOUND(InData%WaveAccMCF,2), UBOUND(InData%WaveAccMCF,2) - DO i1 = LBOUND(InData%WaveAccMCF,1), UBOUND(InData%WaveAccMCF,1) - ReKiBuf(Re_Xferred) = InData%WaveAccMCF(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveVel,5), UBOUND(InData%WaveVel,5) - DO i4 = LBOUND(InData%WaveVel,4), UBOUND(InData%WaveVel,4) - DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) - DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) - DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) - ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveDynP0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PWaveDynP0,3), UBOUND(InData%PWaveDynP0,3) - DO i2 = LBOUND(InData%PWaveDynP0,2), UBOUND(InData%PWaveDynP0,2) - DO i1 = LBOUND(InData%PWaveDynP0,1), UBOUND(InData%PWaveDynP0,1) - ReKiBuf(Re_Xferred) = InData%PWaveDynP0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveAcc0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveAcc0,4), UBOUND(InData%PWaveAcc0,4) - DO i3 = LBOUND(InData%PWaveAcc0,3), UBOUND(InData%PWaveAcc0,3) - DO i2 = LBOUND(InData%PWaveAcc0,2), UBOUND(InData%PWaveAcc0,2) - DO i1 = LBOUND(InData%PWaveAcc0,1), UBOUND(InData%PWaveAcc0,1) - ReKiBuf(Re_Xferred) = InData%PWaveAcc0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveAccMCF0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveAccMCF0,4), UBOUND(InData%PWaveAccMCF0,4) - DO i3 = LBOUND(InData%PWaveAccMCF0,3), UBOUND(InData%PWaveAccMCF0,3) - DO i2 = LBOUND(InData%PWaveAccMCF0,2), UBOUND(InData%PWaveAccMCF0,2) - DO i1 = LBOUND(InData%PWaveAccMCF0,1), UBOUND(InData%PWaveAccMCF0,1) - ReKiBuf(Re_Xferred) = InData%PWaveAccMCF0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveVel0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveVel0,4), UBOUND(InData%PWaveVel0,4) - DO i3 = LBOUND(InData%PWaveVel0,3), UBOUND(InData%PWaveVel0,3) - DO i2 = LBOUND(InData%PWaveVel0,2), UBOUND(InData%PWaveVel0,2) - DO i1 = LBOUND(InData%PWaveVel0,1), UBOUND(InData%PWaveVel0,1) - ReKiBuf(Re_Xferred) = InData%PWaveVel0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveElev1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElev1,3), UBOUND(InData%WaveElev1,3) - DO i2 = LBOUND(InData%WaveElev1,2), UBOUND(InData%WaveElev1,2) - DO i1 = LBOUND(InData%WaveElev1,1), UBOUND(InData%WaveElev1,1) - ReKiBuf(Re_Xferred) = InData%WaveElev1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveElev2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElev2,3), UBOUND(InData%WaveElev2,3) - DO i2 = LBOUND(InData%WaveElev2,2), UBOUND(InData%WaveElev2,2) - DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) - ReKiBuf(Re_Xferred) = InData%WaveElev2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -873,354 +270,17 @@ SUBROUTINE SeaSt_WaveField_UnPackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveDynP)) DEALLOCATE(OutData%WaveDynP) - ALLOCATE(OutData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%WaveDynP,4), UBOUND(OutData%WaveDynP,4) - DO i3 = LBOUND(OutData%WaveDynP,3), UBOUND(OutData%WaveDynP,3) - DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) - DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) - OutData%WaveDynP(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveAcc)) DEALLOCATE(OutData%WaveAcc) - ALLOCATE(OutData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAcc,5), UBOUND(OutData%WaveAcc,5) - DO i4 = LBOUND(OutData%WaveAcc,4), UBOUND(OutData%WaveAcc,4) - DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) - DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) - DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) - OutData%WaveAcc(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAccMCF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveAccMCF)) DEALLOCATE(OutData%WaveAccMCF) - ALLOCATE(OutData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAccMCF,5), UBOUND(OutData%WaveAccMCF,5) - DO i4 = LBOUND(OutData%WaveAccMCF,4), UBOUND(OutData%WaveAccMCF,4) - DO i3 = LBOUND(OutData%WaveAccMCF,3), UBOUND(OutData%WaveAccMCF,3) - DO i2 = LBOUND(OutData%WaveAccMCF,2), UBOUND(OutData%WaveAccMCF,2) - DO i1 = LBOUND(OutData%WaveAccMCF,1), UBOUND(OutData%WaveAccMCF,1) - OutData%WaveAccMCF(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveVel)) DEALLOCATE(OutData%WaveVel) - ALLOCATE(OutData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveVel,5), UBOUND(OutData%WaveVel,5) - DO i4 = LBOUND(OutData%WaveVel,4), UBOUND(OutData%WaveVel,4) - DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) - DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) - DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) - OutData%WaveVel(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveDynP0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveDynP0)) DEALLOCATE(OutData%PWaveDynP0) - ALLOCATE(OutData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PWaveDynP0,3), UBOUND(OutData%PWaveDynP0,3) - DO i2 = LBOUND(OutData%PWaveDynP0,2), UBOUND(OutData%PWaveDynP0,2) - DO i1 = LBOUND(OutData%PWaveDynP0,1), UBOUND(OutData%PWaveDynP0,1) - OutData%PWaveDynP0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAcc0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveAcc0)) DEALLOCATE(OutData%PWaveAcc0) - ALLOCATE(OutData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveAcc0,4), UBOUND(OutData%PWaveAcc0,4) - DO i3 = LBOUND(OutData%PWaveAcc0,3), UBOUND(OutData%PWaveAcc0,3) - DO i2 = LBOUND(OutData%PWaveAcc0,2), UBOUND(OutData%PWaveAcc0,2) - DO i1 = LBOUND(OutData%PWaveAcc0,1), UBOUND(OutData%PWaveAcc0,1) - OutData%PWaveAcc0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAccMCF0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveAccMCF0)) DEALLOCATE(OutData%PWaveAccMCF0) - ALLOCATE(OutData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveAccMCF0,4), UBOUND(OutData%PWaveAccMCF0,4) - DO i3 = LBOUND(OutData%PWaveAccMCF0,3), UBOUND(OutData%PWaveAccMCF0,3) - DO i2 = LBOUND(OutData%PWaveAccMCF0,2), UBOUND(OutData%PWaveAccMCF0,2) - DO i1 = LBOUND(OutData%PWaveAccMCF0,1), UBOUND(OutData%PWaveAccMCF0,1) - OutData%PWaveAccMCF0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveVel0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveVel0)) DEALLOCATE(OutData%PWaveVel0) - ALLOCATE(OutData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveVel0,4), UBOUND(OutData%PWaveVel0,4) - DO i3 = LBOUND(OutData%PWaveVel0,3), UBOUND(OutData%PWaveVel0,3) - DO i2 = LBOUND(OutData%PWaveVel0,2), UBOUND(OutData%PWaveVel0,2) - DO i1 = LBOUND(OutData%PWaveVel0,1), UBOUND(OutData%PWaveVel0,1) - OutData%PWaveVel0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElev1)) DEALLOCATE(OutData%WaveElev1) - ALLOCATE(OutData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElev1,3), UBOUND(OutData%WaveElev1,3) - DO i2 = LBOUND(OutData%WaveElev1,2), UBOUND(OutData%WaveElev1,2) - DO i1 = LBOUND(OutData%WaveElev1,1), UBOUND(OutData%WaveElev1,1) - OutData%WaveElev1(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElev2)) DEALLOCATE(OutData%WaveElev2) - ALLOCATE(OutData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElev2,3), UBOUND(OutData%WaveElev2,3) - DO i2 = LBOUND(OutData%WaveElev2,2), UBOUND(OutData%WaveElev2,2) - DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) - OutData%WaveElev2(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF + NULLIFY(OutData%WaveTime) + NULLIFY(OutData%WaveDynP) + NULLIFY(OutData%WaveAcc) + NULLIFY(OutData%WaveAccMCF) + NULLIFY(OutData%WaveVel) + NULLIFY(OutData%PWaveDynP0) + NULLIFY(OutData%PWaveAcc0) + NULLIFY(OutData%PWaveAccMCF0) + NULLIFY(OutData%PWaveVel0) + NULLIFY(OutData%WaveElev1) + NULLIFY(OutData%WaveElev2) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 4ac799d71c..a42e02f325 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -656,12 +656,12 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init !................................ SUBROUTINE CleanUp() - CALL SeaSt_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2, DEALLOCATEpointers = .FALSE. );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL SeaSt_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) CALL NWTC_Library_DestroyFileInfoType(InFileInfo,ErrStat2, ErrMsg2, DEALLOCATEpointers = .FALSE. );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! Note: all pointers possibly allocated in Waves_init and Waves2_init are transferred to SeaSt parameters before deallocating them: - CALL Waves_DestroyInitOutput( Waves_InitOut, ErrStat2, ErrMsg2, DEALLOCATEpointers = .FALSE. ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL Waves2_DestroyInitOutput( Waves2_InitOut, ErrStat2, ErrMsg2, DEALLOCATEpointers = .FALSE. ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL Waves_DestroyInitOutput( Waves_InitOut, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL Waves2_DestroyInitOutput( Waves2_InitOut, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) CALL Current_DestroyInitOutput( Current_InitOut, ErrStat2, ErrMsg2);CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) diff --git a/modules/seastate/src/SeaState_DriverCode.f90 b/modules/seastate/src/SeaState_DriverCode.f90 index 0c31a57531..ae6bad8550 100644 --- a/modules/seastate/src/SeaState_DriverCode.f90 +++ b/modules/seastate/src/SeaState_DriverCode.f90 @@ -226,8 +226,8 @@ program SeaStateDriver ! Destroy initialization data - call SeaSt_DestroyInitInput( InitInData, ErrStat, ErrMsg, DEALLOCATEpointers = .false. ) - call SeaSt_DestroyInitOutput( InitOutData, ErrStat, ErrMsg, DEALLOCATEpointers = .false. ) + call SeaSt_DestroyInitInput( InitInData, ErrStat, ErrMsg ) + call SeaSt_DestroyInitOutput( InitOutData, ErrStat, ErrMsg ) if (errStat >= AbortErrLev) then @@ -291,7 +291,7 @@ subroutine SeaSt_DvrCleanup() errStat2 = ErrID_None errMsg2 = "" - call SeaSt_DestroyInitInput( InitInData, errStat2, errMsg2, DEALLOCATEpointers = .false. ) + call SeaSt_DestroyInitInput( InitInData, errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, 'SeaSt_DvrCleanup' ) call SeaSt_End( u(1), p, x, xd, z, OtherState, y, m, errStat2, errMsg2 ) diff --git a/modules/seastate/src/SeaState_Interp_Types.f90 b/modules/seastate/src/SeaState_Interp_Types.f90 index e7906d9d58..685dcba373 100644 --- a/modules/seastate/src/SeaState_Interp_Types.f90 +++ b/modules/seastate/src/SeaState_Interp_Types.f90 @@ -85,14 +85,12 @@ SUBROUTINE SeaSt_Interp_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlC DstInitInputData%Z_Depth = SrcInitInputData%Z_Depth END SUBROUTINE SeaSt_Interp_CopyInitInput - SUBROUTINE SeaSt_Interp_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SeaSt_Interp_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(SeaSt_Interp_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_DestroyInitInput' @@ -100,12 +98,6 @@ SUBROUTINE SeaSt_Interp_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SeaSt_Interp_DestroyInitInput SUBROUTINE SeaSt_Interp_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -258,14 +250,12 @@ SUBROUTINE SeaSt_Interp_CopyInitOutput( SrcInitOutputData, DstInitOutputData, Ct IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE SeaSt_Interp_CopyInitOutput - SUBROUTINE SeaSt_Interp_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SeaSt_Interp_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(SeaSt_Interp_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_DestroyInitOutput' @@ -273,13 +263,7 @@ SUBROUTINE SeaSt_Interp_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEAL ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SeaSt_Interp_DestroyInitOutput @@ -320,7 +304,7 @@ SUBROUTINE SeaSt_Interp_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -363,7 +347,7 @@ SUBROUTINE SeaSt_Interp_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS Db_Xferred = 1 Int_Xferred = 1 - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -452,7 +436,7 @@ SUBROUTINE SeaSt_Interp_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -483,14 +467,12 @@ SUBROUTINE SeaSt_Interp_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, E DstMiscData%FirstWarn_Clamp = SrcMiscData%FirstWarn_Clamp END SUBROUTINE SeaSt_Interp_CopyMisc - SUBROUTINE SeaSt_Interp_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SeaSt_Interp_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_DestroyMisc' @@ -498,12 +480,6 @@ SUBROUTINE SeaSt_Interp_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SeaSt_Interp_DestroyMisc SUBROUTINE SeaSt_Interp_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -669,14 +645,12 @@ SUBROUTINE SeaSt_Interp_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat DstParamData%Z_Depth = SrcParamData%Z_Depth END SUBROUTINE SeaSt_Interp_CopyParam - SUBROUTINE SeaSt_Interp_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SeaSt_Interp_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(SeaSt_Interp_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_DestroyParam' @@ -684,12 +658,6 @@ SUBROUTINE SeaSt_Interp_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SeaSt_Interp_DestroyParam SUBROUTINE SeaSt_Interp_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 420e3ee20b..77ef809eb4 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -34,6 +34,7 @@ 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 @@ -228,10 +229,6 @@ SUBROUTINE SeaSt_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, Er ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_CopyInputFile' @@ -338,14 +335,12 @@ SUBROUTINE SeaSt_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, Er DstInputFileData%OutSFmt = SrcInputFileData%OutSFmt END SUBROUTINE SeaSt_CopyInputFile - SUBROUTINE SeaSt_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SeaSt_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) TYPE(SeaSt_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyInputFile' @@ -353,17 +348,11 @@ SUBROUTINE SeaSt_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL Waves_DestroyInitInput( InputFileData%Waves, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Waves_DestroyInitInput( InputFileData%Waves, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Waves2_DestroyInitInput( InputFileData%Waves2, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Waves2_DestroyInitInput( InputFileData%Waves2, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Current_DestroyInitInput( InputFileData%Current, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Current_DestroyInitInput( InputFileData%Current, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InputFileData%WaveElevxi)) THEN DEALLOCATE(InputFileData%WaveElevxi) @@ -776,10 +765,6 @@ SUBROUTINE SeaSt_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_UnPackInputFile' @@ -1112,14 +1097,12 @@ SUBROUTINE SeaSt_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%Linearize = SrcInitInputData%Linearize END SUBROUTINE SeaSt_CopyInitInput - SUBROUTINE SeaSt_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SeaSt_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(SeaSt_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyInitInput' @@ -1127,13 +1110,7 @@ SUBROUTINE SeaSt_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedFileData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedFileData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitInputData%WaveElevXY)) THEN DEALLOCATE(InitInputData%WaveElevXY) @@ -1179,7 +1156,7 @@ SUBROUTINE SeaSt_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_BufSz = Int_BufSz + 1 ! UseInputFile ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! PassedFileData: size of buffers for each call to pack subtype - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1245,7 +1222,7 @@ SUBROUTINE SeaSt_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err END DO ! I IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1388,7 +1365,7 @@ SUBROUTINE SeaSt_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackfileinfotype( Re_Buf, Db_Buf, Int_Buf, OutData%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData + CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1495,20 +1472,7 @@ SUBROUTINE SeaSt_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WtrDens = SrcInitOutputData%WtrDens DstInitOutputData%WtrDpth = SrcInitOutputData%WtrDpth DstInitOutputData%MSL2SWL = SrcInitOutputData%MSL2SWL -IF (ASSOCIATED(SrcInitOutputData%WaveElevC0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElevC0,1) - i1_u = UBOUND(SrcInitOutputData%WaveElevC0,1) - i2_l = LBOUND(SrcInitOutputData%WaveElevC0,2) - i2_u = UBOUND(SrcInitOutputData%WaveElevC0,2) - IF (.NOT. ASSOCIATED(DstInitOutputData%WaveElevC0)) THEN - ALLOCATE(DstInitOutputData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElevC0 = SrcInitOutputData%WaveElevC0 -ENDIF + DstInitOutputData%WaveElevC0 => SrcInitOutputData%WaveElevC0 IF (ALLOCATED(SrcInitOutputData%WaveElevC)) THEN i1_l = LBOUND(SrcInitOutputData%WaveElevC,1) i1_u = UBOUND(SrcInitOutputData%WaveElevC,1) @@ -1525,203 +1489,22 @@ SUBROUTINE SeaSt_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, END IF DstInitOutputData%WaveElevC = SrcInitOutputData%WaveElevC ENDIF -IF (ASSOCIATED(SrcInitOutputData%WaveDirArr)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveDirArr,1) - i1_u = UBOUND(SrcInitOutputData%WaveDirArr,1) - IF (.NOT. ASSOCIATED(DstInitOutputData%WaveDirArr)) THEN - ALLOCATE(DstInitOutputData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveDirArr = SrcInitOutputData%WaveDirArr -ENDIF + DstInitOutputData%WaveDirArr => SrcInitOutputData%WaveDirArr DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax DstInitOutputData%WaveDir = SrcInitOutputData%WaveDir DstInitOutputData%WaveMultiDir = SrcInitOutputData%WaveMultiDir DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega -IF (ASSOCIATED(SrcInitOutputData%WaveDynP)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveDynP,1) - i1_u = UBOUND(SrcInitOutputData%WaveDynP,1) - i2_l = LBOUND(SrcInitOutputData%WaveDynP,2) - i2_u = UBOUND(SrcInitOutputData%WaveDynP,2) - i3_l = LBOUND(SrcInitOutputData%WaveDynP,3) - i3_u = UBOUND(SrcInitOutputData%WaveDynP,3) - i4_l = LBOUND(SrcInitOutputData%WaveDynP,4) - i4_u = UBOUND(SrcInitOutputData%WaveDynP,4) - IF (.NOT. ASSOCIATED(DstInitOutputData%WaveDynP)) THEN - ALLOCATE(DstInitOutputData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveDynP = SrcInitOutputData%WaveDynP -ENDIF -IF (ASSOCIATED(SrcInitOutputData%WaveAcc)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveAcc,1) - i1_u = UBOUND(SrcInitOutputData%WaveAcc,1) - i2_l = LBOUND(SrcInitOutputData%WaveAcc,2) - i2_u = UBOUND(SrcInitOutputData%WaveAcc,2) - i3_l = LBOUND(SrcInitOutputData%WaveAcc,3) - i3_u = UBOUND(SrcInitOutputData%WaveAcc,3) - i4_l = LBOUND(SrcInitOutputData%WaveAcc,4) - i4_u = UBOUND(SrcInitOutputData%WaveAcc,4) - i5_l = LBOUND(SrcInitOutputData%WaveAcc,5) - i5_u = UBOUND(SrcInitOutputData%WaveAcc,5) - IF (.NOT. ASSOCIATED(DstInitOutputData%WaveAcc)) THEN - ALLOCATE(DstInitOutputData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveAcc = SrcInitOutputData%WaveAcc -ENDIF -IF (ASSOCIATED(SrcInitOutputData%WaveAccMCF)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveAccMCF,1) - i1_u = UBOUND(SrcInitOutputData%WaveAccMCF,1) - i2_l = LBOUND(SrcInitOutputData%WaveAccMCF,2) - i2_u = UBOUND(SrcInitOutputData%WaveAccMCF,2) - i3_l = LBOUND(SrcInitOutputData%WaveAccMCF,3) - i3_u = UBOUND(SrcInitOutputData%WaveAccMCF,3) - i4_l = LBOUND(SrcInitOutputData%WaveAccMCF,4) - i4_u = UBOUND(SrcInitOutputData%WaveAccMCF,4) - i5_l = LBOUND(SrcInitOutputData%WaveAccMCF,5) - i5_u = UBOUND(SrcInitOutputData%WaveAccMCF,5) - IF (.NOT. ASSOCIATED(DstInitOutputData%WaveAccMCF)) THEN - ALLOCATE(DstInitOutputData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveAccMCF = SrcInitOutputData%WaveAccMCF -ENDIF -IF (ASSOCIATED(SrcInitOutputData%WaveVel)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveVel,1) - i1_u = UBOUND(SrcInitOutputData%WaveVel,1) - i2_l = LBOUND(SrcInitOutputData%WaveVel,2) - i2_u = UBOUND(SrcInitOutputData%WaveVel,2) - i3_l = LBOUND(SrcInitOutputData%WaveVel,3) - i3_u = UBOUND(SrcInitOutputData%WaveVel,3) - i4_l = LBOUND(SrcInitOutputData%WaveVel,4) - i4_u = UBOUND(SrcInitOutputData%WaveVel,4) - i5_l = LBOUND(SrcInitOutputData%WaveVel,5) - i5_u = UBOUND(SrcInitOutputData%WaveVel,5) - IF (.NOT. ASSOCIATED(DstInitOutputData%WaveVel)) THEN - ALLOCATE(DstInitOutputData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveVel = SrcInitOutputData%WaveVel -ENDIF -IF (ASSOCIATED(SrcInitOutputData%PWaveDynP0)) THEN - i1_l = LBOUND(SrcInitOutputData%PWaveDynP0,1) - i1_u = UBOUND(SrcInitOutputData%PWaveDynP0,1) - i2_l = LBOUND(SrcInitOutputData%PWaveDynP0,2) - i2_u = UBOUND(SrcInitOutputData%PWaveDynP0,2) - i3_l = LBOUND(SrcInitOutputData%PWaveDynP0,3) - i3_u = UBOUND(SrcInitOutputData%PWaveDynP0,3) - IF (.NOT. ASSOCIATED(DstInitOutputData%PWaveDynP0)) THEN - ALLOCATE(DstInitOutputData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%PWaveDynP0 = SrcInitOutputData%PWaveDynP0 -ENDIF -IF (ASSOCIATED(SrcInitOutputData%PWaveAcc0)) THEN - i1_l = LBOUND(SrcInitOutputData%PWaveAcc0,1) - i1_u = UBOUND(SrcInitOutputData%PWaveAcc0,1) - i2_l = LBOUND(SrcInitOutputData%PWaveAcc0,2) - i2_u = UBOUND(SrcInitOutputData%PWaveAcc0,2) - i3_l = LBOUND(SrcInitOutputData%PWaveAcc0,3) - i3_u = UBOUND(SrcInitOutputData%PWaveAcc0,3) - i4_l = LBOUND(SrcInitOutputData%PWaveAcc0,4) - i4_u = UBOUND(SrcInitOutputData%PWaveAcc0,4) - IF (.NOT. ASSOCIATED(DstInitOutputData%PWaveAcc0)) THEN - ALLOCATE(DstInitOutputData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%PWaveAcc0 = SrcInitOutputData%PWaveAcc0 -ENDIF -IF (ASSOCIATED(SrcInitOutputData%PWaveAccMCF0)) THEN - i1_l = LBOUND(SrcInitOutputData%PWaveAccMCF0,1) - i1_u = UBOUND(SrcInitOutputData%PWaveAccMCF0,1) - i2_l = LBOUND(SrcInitOutputData%PWaveAccMCF0,2) - i2_u = UBOUND(SrcInitOutputData%PWaveAccMCF0,2) - i3_l = LBOUND(SrcInitOutputData%PWaveAccMCF0,3) - i3_u = UBOUND(SrcInitOutputData%PWaveAccMCF0,3) - i4_l = LBOUND(SrcInitOutputData%PWaveAccMCF0,4) - i4_u = UBOUND(SrcInitOutputData%PWaveAccMCF0,4) - IF (.NOT. ASSOCIATED(DstInitOutputData%PWaveAccMCF0)) THEN - ALLOCATE(DstInitOutputData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%PWaveAccMCF0 = SrcInitOutputData%PWaveAccMCF0 -ENDIF -IF (ASSOCIATED(SrcInitOutputData%PWaveVel0)) THEN - i1_l = LBOUND(SrcInitOutputData%PWaveVel0,1) - i1_u = UBOUND(SrcInitOutputData%PWaveVel0,1) - i2_l = LBOUND(SrcInitOutputData%PWaveVel0,2) - i2_u = UBOUND(SrcInitOutputData%PWaveVel0,2) - i3_l = LBOUND(SrcInitOutputData%PWaveVel0,3) - i3_u = UBOUND(SrcInitOutputData%PWaveVel0,3) - i4_l = LBOUND(SrcInitOutputData%PWaveVel0,4) - i4_u = UBOUND(SrcInitOutputData%PWaveVel0,4) - IF (.NOT. ASSOCIATED(DstInitOutputData%PWaveVel0)) THEN - ALLOCATE(DstInitOutputData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%PWaveVel0 = SrcInitOutputData%PWaveVel0 -ENDIF -IF (ASSOCIATED(SrcInitOutputData%WaveElev1)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElev1,1) - i1_u = UBOUND(SrcInitOutputData%WaveElev1,1) - i2_l = LBOUND(SrcInitOutputData%WaveElev1,2) - i2_u = UBOUND(SrcInitOutputData%WaveElev1,2) - i3_l = LBOUND(SrcInitOutputData%WaveElev1,3) - i3_u = UBOUND(SrcInitOutputData%WaveElev1,3) - IF (.NOT. ASSOCIATED(DstInitOutputData%WaveElev1)) THEN - ALLOCATE(DstInitOutputData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElev1 = SrcInitOutputData%WaveElev1 -ENDIF -IF (ASSOCIATED(SrcInitOutputData%WaveElev2)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElev2,1) - i1_u = UBOUND(SrcInitOutputData%WaveElev2,1) - i2_l = LBOUND(SrcInitOutputData%WaveElev2,2) - i2_u = UBOUND(SrcInitOutputData%WaveElev2,2) - i3_l = LBOUND(SrcInitOutputData%WaveElev2,3) - i3_u = UBOUND(SrcInitOutputData%WaveElev2,3) - IF (.NOT. ASSOCIATED(DstInitOutputData%WaveElev2)) THEN - ALLOCATE(DstInitOutputData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElev2 = SrcInitOutputData%WaveElev2 -ENDIF + DstInitOutputData%WaveDynP => SrcInitOutputData%WaveDynP + DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc + DstInitOutputData%WaveAccMCF => SrcInitOutputData%WaveAccMCF + DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel + DstInitOutputData%PWaveDynP0 => SrcInitOutputData%PWaveDynP0 + DstInitOutputData%PWaveAcc0 => SrcInitOutputData%PWaveAcc0 + DstInitOutputData%PWaveAccMCF0 => SrcInitOutputData%PWaveAccMCF0 + DstInitOutputData%PWaveVel0 => SrcInitOutputData%PWaveVel0 + DstInitOutputData%WaveElev1 => SrcInitOutputData%WaveElev1 + DstInitOutputData%WaveElev2 => SrcInitOutputData%WaveElev2 IF (ALLOCATED(SrcInitOutputData%WaveElev0)) THEN i1_l = LBOUND(SrcInitOutputData%WaveElev0,1) i1_u = UBOUND(SrcInitOutputData%WaveElev0,1) @@ -1734,18 +1517,7 @@ SUBROUTINE SeaSt_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, END IF DstInitOutputData%WaveElev0 = SrcInitOutputData%WaveElev0 ENDIF -IF (ASSOCIATED(SrcInitOutputData%WaveTime)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveTime,1) - i1_u = UBOUND(SrcInitOutputData%WaveTime,1) - IF (.NOT. ASSOCIATED(DstInitOutputData%WaveTime)) THEN - ALLOCATE(DstInitOutputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveTime = SrcInitOutputData%WaveTime -ENDIF + DstInitOutputData%WaveTime => SrcInitOutputData%WaveTime DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 @@ -1782,14 +1554,12 @@ SUBROUTINE SeaSt_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE SeaSt_CopyInitOutput - SUBROUTINE SeaSt_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SeaSt_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(SeaSt_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyInitOutput' @@ -1797,97 +1567,39 @@ SUBROUTINE SeaSt_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) ENDIF IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN DEALLOCATE(InitOutputData%WriteOutputUnt) ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ASSOCIATED(InitOutputData%WaveElevC0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%WaveElevC0) - InitOutputData%WaveElevC0 => NULL() -ENDIF +NULLIFY(InitOutputData%WaveElevC0) IF (ALLOCATED(InitOutputData%WaveElevC)) THEN DEALLOCATE(InitOutputData%WaveElevC) ENDIF -IF (ASSOCIATED(InitOutputData%WaveDirArr)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%WaveDirArr) - InitOutputData%WaveDirArr => NULL() -ENDIF -IF (ASSOCIATED(InitOutputData%WaveDynP)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%WaveDynP) - InitOutputData%WaveDynP => NULL() -ENDIF -IF (ASSOCIATED(InitOutputData%WaveAcc)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%WaveAcc) - InitOutputData%WaveAcc => NULL() -ENDIF -IF (ASSOCIATED(InitOutputData%WaveAccMCF)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%WaveAccMCF) - InitOutputData%WaveAccMCF => NULL() -ENDIF -IF (ASSOCIATED(InitOutputData%WaveVel)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%WaveVel) - InitOutputData%WaveVel => NULL() -ENDIF -IF (ASSOCIATED(InitOutputData%PWaveDynP0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%PWaveDynP0) - InitOutputData%PWaveDynP0 => NULL() -ENDIF -IF (ASSOCIATED(InitOutputData%PWaveAcc0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%PWaveAcc0) - InitOutputData%PWaveAcc0 => NULL() -ENDIF -IF (ASSOCIATED(InitOutputData%PWaveAccMCF0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%PWaveAccMCF0) - InitOutputData%PWaveAccMCF0 => NULL() -ENDIF -IF (ASSOCIATED(InitOutputData%PWaveVel0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%PWaveVel0) - InitOutputData%PWaveVel0 => NULL() -ENDIF -IF (ASSOCIATED(InitOutputData%WaveElev1)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%WaveElev1) - InitOutputData%WaveElev1 => NULL() -ENDIF -IF (ASSOCIATED(InitOutputData%WaveElev2)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%WaveElev2) - InitOutputData%WaveElev2 => NULL() -ENDIF +NULLIFY(InitOutputData%WaveDirArr) +NULLIFY(InitOutputData%WaveDynP) +NULLIFY(InitOutputData%WaveAcc) +NULLIFY(InitOutputData%WaveAccMCF) +NULLIFY(InitOutputData%WaveVel) +NULLIFY(InitOutputData%PWaveDynP0) +NULLIFY(InitOutputData%PWaveAcc0) +NULLIFY(InitOutputData%PWaveAccMCF0) +NULLIFY(InitOutputData%PWaveVel0) +NULLIFY(InitOutputData%WaveElev1) +NULLIFY(InitOutputData%WaveElev2) IF (ALLOCATED(InitOutputData%WaveElev0)) THEN DEALLOCATE(InitOutputData%WaveElev0) ENDIF -IF (ASSOCIATED(InitOutputData%WaveTime)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%WaveTime) - InitOutputData%WaveTime => NULL() -ENDIF - CALL SeaSt_Interp_DestroyParam( InitOutputData%SeaSt_Interp_p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +NULLIFY(InitOutputData%WaveTime) + CALL SeaSt_Interp_DestroyParam( InitOutputData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitOutputData%WaveElevSeries)) THEN DEALLOCATE(InitOutputData%WaveElevSeries) ENDIF - CALL SeaSt_WaveField_Destroyseast_wavefieldtype( InitOutputData%WaveField, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_WaveField_DestroySeaSt_WaveFieldType( InitOutputData%WaveField, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SeaSt_DestroyInitOutput @@ -1938,7 +1650,7 @@ SUBROUTINE SeaSt_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1957,85 +1669,20 @@ SUBROUTINE SeaSt_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Re_BufSz = Re_BufSz + 1 ! WtrDens Re_BufSz = Re_BufSz + 1 ! WtrDpth Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1 ! WaveElevC0 allocated yes/no - IF ( ASSOCIATED(InData%WaveElevC0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevC0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC0) ! WaveElevC0 - END IF Int_BufSz = Int_BufSz + 1 ! WaveElevC allocated yes/no IF ( ALLOCATED(InData%WaveElevC) ) THEN Int_BufSz = Int_BufSz + 2*3 ! WaveElevC upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC) ! WaveElevC - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDirArr allocated yes/no - IF ( ASSOCIATED(InData%WaveDirArr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveDirArr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDirArr) ! WaveDirArr END IF Re_BufSz = Re_BufSz + 1 ! WaveDirMin Re_BufSz = Re_BufSz + 1 ! WaveDirMax Re_BufSz = Re_BufSz + 1 ! WaveDir Int_BufSz = Int_BufSz + 1 ! WaveMultiDir Re_BufSz = Re_BufSz + 1 ! WaveDOmega - Int_BufSz = Int_BufSz + 1 ! WaveDynP allocated yes/no - IF ( ASSOCIATED(InData%WaveDynP) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! WaveDynP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP) ! WaveDynP - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc allocated yes/no - IF ( ASSOCIATED(InData%WaveAcc) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveAcc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc) ! WaveAcc - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAccMCF allocated yes/no - IF ( ASSOCIATED(InData%WaveAccMCF) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveAccMCF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAccMCF) ! WaveAccMCF - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel allocated yes/no - IF ( ASSOCIATED(InData%WaveVel) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel) ! WaveVel - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveDynP0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveDynP0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PWaveDynP0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveDynP0) ! PWaveDynP0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveAcc0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveAcc0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveAcc0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveAcc0) ! PWaveAcc0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveAccMCF0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveAccMCF0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveAccMCF0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveAccMCF0) ! PWaveAccMCF0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveVel0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveVel0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveVel0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveVel0) ! PWaveVel0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev1 allocated yes/no - IF ( ASSOCIATED(InData%WaveElev1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElev1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev1) ! WaveElev1 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev2 allocated yes/no - IF ( ASSOCIATED(InData%WaveElev2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElev2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev2) ! WaveElev2 - END IF Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no IF ( ALLOCATED(InData%WaveElev0) ) THEN Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ASSOCIATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime END IF Re_BufSz = Re_BufSz + 1 ! RhoXg Int_BufSz = Int_BufSz + 1 ! NStepWave @@ -2074,7 +1721,7 @@ SUBROUTINE SeaSt_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Re_BufSz = Re_BufSz + SIZE(InData%WaveElevSeries) ! WaveElevSeries END IF Int_BufSz = Int_BufSz + 3 ! WaveField: size of buffers for each call to pack subtype - CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField + CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2151,7 +1798,7 @@ SUBROUTINE SeaSt_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END DO ! I END DO END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2185,26 +1832,6 @@ SUBROUTINE SeaSt_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%MSL2SWL Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ASSOCIATED(InData%WaveElevC0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) - DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF IF ( .NOT. ALLOCATED(InData%WaveElevC) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2229,21 +1856,6 @@ SUBROUTINE SeaSt_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END DO END DO END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveDirArr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDirArr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) - ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) - Re_Xferred = Re_Xferred + 1 - END DO END IF ReKiBuf(Re_Xferred) = InData%WaveDirMin Re_Xferred = Re_Xferred + 1 @@ -2255,415 +1867,100 @@ SUBROUTINE SeaSt_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_Xferred = Int_Xferred + 1 ReKiBuf(Re_Xferred) = InData%WaveDOmega Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ASSOCIATED(InData%WaveDynP) ) THEN + IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,4) + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) Int_Xferred = Int_Xferred + 2 - DO i4 = LBOUND(InData%WaveDynP,4), UBOUND(InData%WaveDynP,4) - DO i3 = LBOUND(InData%WaveDynP,3), UBOUND(InData%WaveDynP,3) - DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) - DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO + DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) + ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) + Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( .NOT. ASSOCIATED(InData%WaveAcc) ) THEN - IntKiBuf( Int_Xferred ) = 0 + ReKiBuf(Re_Xferred) = InData%RhoXg + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 + IntKiBuf(Int_Xferred) = InData%NStepWave2 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveAcc,5), UBOUND(InData%WaveAcc,5) - DO i4 = LBOUND(InData%WaveAcc,4), UBOUND(InData%WaveAcc,4) - DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) - DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) - DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveAccMCF) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IntKiBuf(Int_Xferred) = InData%WaveMod Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 + IntKiBuf(Int_Xferred) = InData%WaveStMod Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveAccMCF,5), UBOUND(InData%WaveAccMCF,5) - DO i4 = LBOUND(InData%WaveAccMCF,4), UBOUND(InData%WaveAccMCF,4) - DO i3 = LBOUND(InData%WaveAccMCF,3), UBOUND(InData%WaveAccMCF,3) - DO i2 = LBOUND(InData%WaveAccMCF,2), UBOUND(InData%WaveAccMCF,2) - DO i1 = LBOUND(InData%WaveAccMCF,1), UBOUND(InData%WaveAccMCF,1) - ReKiBuf(Re_Xferred) = InData%WaveAccMCF(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IntKiBuf(Int_Xferred) = InData%WaveDirMod Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOffD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOffD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOffS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOffS + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%InvalidWithSSExctn, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,5) - Int_Xferred = Int_Xferred + 2 + CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - DO i5 = LBOUND(InData%WaveVel,5), UBOUND(InData%WaveVel,5) - DO i4 = LBOUND(InData%WaveVel,4), UBOUND(InData%WaveVel,4) - DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) - DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) - DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) - ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveDynP0) ) THEN + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + ReKiBuf(Re_Xferred) = InData%MCFD + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%WaveElevSeries) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,3) + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,2) Int_Xferred = Int_Xferred + 2 - DO i3 = LBOUND(InData%PWaveDynP0,3), UBOUND(InData%PWaveDynP0,3) - DO i2 = LBOUND(InData%PWaveDynP0,2), UBOUND(InData%PWaveDynP0,2) - DO i1 = LBOUND(InData%PWaveDynP0,1), UBOUND(InData%PWaveDynP0,1) - ReKiBuf(Re_Xferred) = InData%PWaveDynP0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO + DO i2 = LBOUND(InData%WaveElevSeries,2), UBOUND(InData%WaveElevSeries,2) + DO i1 = LBOUND(InData%WaveElevSeries,1), UBOUND(InData%WaveElevSeries,1) + ReKiBuf(Re_Xferred) = InData%WaveElevSeries(i1,i2) + Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( .NOT. ASSOCIATED(InData%PWaveAcc0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveAcc0,4), UBOUND(InData%PWaveAcc0,4) - DO i3 = LBOUND(InData%PWaveAcc0,3), UBOUND(InData%PWaveAcc0,3) - DO i2 = LBOUND(InData%PWaveAcc0,2), UBOUND(InData%PWaveAcc0,2) - DO i1 = LBOUND(InData%PWaveAcc0,1), UBOUND(InData%PWaveAcc0,1) - ReKiBuf(Re_Xferred) = InData%PWaveAcc0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveAccMCF0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveAccMCF0,4), UBOUND(InData%PWaveAccMCF0,4) - DO i3 = LBOUND(InData%PWaveAccMCF0,3), UBOUND(InData%PWaveAccMCF0,3) - DO i2 = LBOUND(InData%PWaveAccMCF0,2), UBOUND(InData%PWaveAccMCF0,2) - DO i1 = LBOUND(InData%PWaveAccMCF0,1), UBOUND(InData%PWaveAccMCF0,1) - ReKiBuf(Re_Xferred) = InData%PWaveAccMCF0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveVel0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveVel0,4), UBOUND(InData%PWaveVel0,4) - DO i3 = LBOUND(InData%PWaveVel0,3), UBOUND(InData%PWaveVel0,3) - DO i2 = LBOUND(InData%PWaveVel0,2), UBOUND(InData%PWaveVel0,2) - DO i1 = LBOUND(InData%PWaveVel0,1), UBOUND(InData%PWaveVel0,1) - ReKiBuf(Re_Xferred) = InData%PWaveVel0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveElev1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElev1,3), UBOUND(InData%WaveElev1,3) - DO i2 = LBOUND(InData%WaveElev1,2), UBOUND(InData%WaveElev1,2) - DO i1 = LBOUND(InData%WaveElev1,1), UBOUND(InData%WaveElev1,1) - ReKiBuf(Re_Xferred) = InData%WaveElev1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveElev2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElev2,3), UBOUND(InData%WaveElev2,3) - DO i2 = LBOUND(InData%WaveElev2,2), UBOUND(InData%WaveElev2,2) - DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) - ReKiBuf(Re_Xferred) = InData%WaveElev2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) - ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%RhoXg - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveDirMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOffS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOffS - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%InvalidWithSSExctn, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - ReKiBuf(Re_Xferred) = InData%MCFD - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElevSeries) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevSeries,2), UBOUND(InData%WaveElevSeries,2) - DO i1 = LBOUND(InData%WaveElevSeries,1), UBOUND(InData%WaveElevSeries,1) - ReKiBuf(Re_Xferred) = InData%WaveElevSeries(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf)) THEN IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 @@ -2706,490 +2003,110 @@ SUBROUTINE SeaSt_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: i INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElevC0)) DEALLOCATE(OutData%WaveElevC0) - ALLOCATE(OutData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) - DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) - OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevC)) DEALLOCATE(OutData%WaveElevC) - ALLOCATE(OutData%WaveElevC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElevC,3), UBOUND(OutData%WaveElevC,3) - DO i2 = LBOUND(OutData%WaveElevC,2), UBOUND(OutData%WaveElevC,2) - DO i1 = LBOUND(OutData%WaveElevC,1), UBOUND(OutData%WaveElevC,1) - OutData%WaveElevC(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveDirArr)) DEALLOCATE(OutData%WaveDirArr) - ALLOCATE(OutData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) - OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveDynP)) DEALLOCATE(OutData%WaveDynP) - ALLOCATE(OutData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%WaveDynP,4), UBOUND(OutData%WaveDynP,4) - DO i3 = LBOUND(OutData%WaveDynP,3), UBOUND(OutData%WaveDynP,3) - DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) - DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) - OutData%WaveDynP(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveAcc)) DEALLOCATE(OutData%WaveAcc) - ALLOCATE(OutData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAcc,5), UBOUND(OutData%WaveAcc,5) - DO i4 = LBOUND(OutData%WaveAcc,4), UBOUND(OutData%WaveAcc,4) - DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) - DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) - DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) - OutData%WaveAcc(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAccMCF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveAccMCF)) DEALLOCATE(OutData%WaveAccMCF) - ALLOCATE(OutData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAccMCF,5), UBOUND(OutData%WaveAccMCF,5) - DO i4 = LBOUND(OutData%WaveAccMCF,4), UBOUND(OutData%WaveAccMCF,4) - DO i3 = LBOUND(OutData%WaveAccMCF,3), UBOUND(OutData%WaveAccMCF,3) - DO i2 = LBOUND(OutData%WaveAccMCF,2), UBOUND(OutData%WaveAccMCF,2) - DO i1 = LBOUND(OutData%WaveAccMCF,1), UBOUND(OutData%WaveAccMCF,1) - OutData%WaveAccMCF(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveVel)) DEALLOCATE(OutData%WaveVel) - ALLOCATE(OutData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveVel,5), UBOUND(OutData%WaveVel,5) - DO i4 = LBOUND(OutData%WaveVel,4), UBOUND(OutData%WaveVel,4) - DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) - DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) - DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) - OutData%WaveVel(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveDynP0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveDynP0)) DEALLOCATE(OutData%PWaveDynP0) - ALLOCATE(OutData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PWaveDynP0,3), UBOUND(OutData%PWaveDynP0,3) - DO i2 = LBOUND(OutData%PWaveDynP0,2), UBOUND(OutData%PWaveDynP0,2) - DO i1 = LBOUND(OutData%PWaveDynP0,1), UBOUND(OutData%PWaveDynP0,1) - OutData%PWaveDynP0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAcc0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveAcc0)) DEALLOCATE(OutData%PWaveAcc0) - ALLOCATE(OutData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveAcc0,4), UBOUND(OutData%PWaveAcc0,4) - DO i3 = LBOUND(OutData%PWaveAcc0,3), UBOUND(OutData%PWaveAcc0,3) - DO i2 = LBOUND(OutData%PWaveAcc0,2), UBOUND(OutData%PWaveAcc0,2) - DO i1 = LBOUND(OutData%PWaveAcc0,1), UBOUND(OutData%PWaveAcc0,1) - OutData%PWaveAcc0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAccMCF0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveAccMCF0)) DEALLOCATE(OutData%PWaveAccMCF0) - ALLOCATE(OutData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveAccMCF0,4), UBOUND(OutData%PWaveAccMCF0,4) - DO i3 = LBOUND(OutData%PWaveAccMCF0,3), UBOUND(OutData%PWaveAccMCF0,3) - DO i2 = LBOUND(OutData%PWaveAccMCF0,2), UBOUND(OutData%PWaveAccMCF0,2) - DO i1 = LBOUND(OutData%PWaveAccMCF0,1), UBOUND(OutData%PWaveAccMCF0,1) - OutData%PWaveAccMCF0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveVel0 not allocated + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_UnPackInitOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveVel0)) DEALLOCATE(OutData%PWaveVel0) - ALLOCATE(OutData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) + ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i4 = LBOUND(OutData%PWaveVel0,4), UBOUND(OutData%PWaveVel0,4) - DO i3 = LBOUND(OutData%PWaveVel0,3), UBOUND(OutData%PWaveVel0,3) - DO i2 = LBOUND(OutData%PWaveVel0,2), UBOUND(OutData%PWaveVel0,2) - DO i1 = LBOUND(OutData%PWaveVel0,1), UBOUND(OutData%PWaveVel0,1) - OutData%PWaveVel0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO I = 1, LEN(OutData%WriteOutputHdr) + OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev1 not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElev1)) DEALLOCATE(OutData%WaveElev1) - ALLOCATE(OutData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) + ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i3 = LBOUND(OutData%WaveElev1,3), UBOUND(OutData%WaveElev1,3) - DO i2 = LBOUND(OutData%WaveElev1,2), UBOUND(OutData%WaveElev1,2) - DO i1 = LBOUND(OutData%WaveElev1,1), UBOUND(OutData%WaveElev1,1) - OutData%WaveElev1(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO I = 1, LEN(OutData%WriteOutputUnt) + OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev2 not allocated + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + NULLIFY(OutData%WaveElevC0) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -3202,21 +2119,42 @@ SUBROUTINE SeaSt_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, i3_l = IntKiBuf( Int_Xferred ) i3_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElev2)) DEALLOCATE(OutData%WaveElev2) - ALLOCATE(OutData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%WaveElevC)) DEALLOCATE(OutData%WaveElevC) + ALLOCATE(OutData%WaveElevC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i3 = LBOUND(OutData%WaveElev2,3), UBOUND(OutData%WaveElev2,3) - DO i2 = LBOUND(OutData%WaveElev2,2), UBOUND(OutData%WaveElev2,2) - DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) - OutData%WaveElev2(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + DO i3 = LBOUND(OutData%WaveElevC,3), UBOUND(OutData%WaveElevC,3) + DO i2 = LBOUND(OutData%WaveElevC,2), UBOUND(OutData%WaveElevC,2) + DO i1 = LBOUND(OutData%WaveElevC,1), UBOUND(OutData%WaveElevC,1) + OutData%WaveElevC(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) Re_Xferred = Re_Xferred + 1 END DO END DO END DO END IF + NULLIFY(OutData%WaveDirArr) + OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + NULLIFY(OutData%WaveDynP) + NULLIFY(OutData%WaveAcc) + NULLIFY(OutData%WaveAccMCF) + NULLIFY(OutData%WaveVel) + NULLIFY(OutData%PWaveDynP0) + NULLIFY(OutData%PWaveAcc0) + NULLIFY(OutData%PWaveAccMCF0) + NULLIFY(OutData%PWaveVel0) + NULLIFY(OutData%WaveElev1) + NULLIFY(OutData%WaveElev2) IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3235,24 +2173,7 @@ SUBROUTINE SeaSt_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF + NULLIFY(OutData%WaveTime) OutData%RhoXg = REAL(ReKiBuf(Re_Xferred), SiKi) Re_Xferred = Re_Xferred + 1 OutData%NStepWave = IntKiBuf(Int_Xferred) @@ -3377,7 +2298,7 @@ SUBROUTINE SeaSt_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SeaSt_WaveField_Unpackseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField + CALL SeaSt_WaveField_UnpackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3403,14 +2324,12 @@ SUBROUTINE SeaSt_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Er DstContStateData%UnusedStates = SrcContStateData%UnusedStates END SUBROUTINE SeaSt_CopyContState - SUBROUTINE SeaSt_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SeaSt_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(SeaSt_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyContState' @@ -3418,12 +2337,6 @@ SUBROUTINE SeaSt_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SeaSt_DestroyContState SUBROUTINE SeaSt_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -3540,14 +2453,12 @@ SUBROUTINE SeaSt_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Er DstDiscStateData%UnusedStates = SrcDiscStateData%UnusedStates END SUBROUTINE SeaSt_CopyDiscState - SUBROUTINE SeaSt_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SeaSt_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(SeaSt_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyDiscState' @@ -3555,12 +2466,6 @@ SUBROUTINE SeaSt_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SeaSt_DestroyDiscState SUBROUTINE SeaSt_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -3677,14 +2582,12 @@ SUBROUTINE SeaSt_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCo DstConstrStateData%UnusedStates = SrcConstrStateData%UnusedStates END SUBROUTINE SeaSt_CopyConstrState - SUBROUTINE SeaSt_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SeaSt_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(SeaSt_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyConstrState' @@ -3692,12 +2595,6 @@ SUBROUTINE SeaSt_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCAT ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SeaSt_DestroyConstrState SUBROUTINE SeaSt_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -3814,14 +2711,12 @@ SUBROUTINE SeaSt_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, DstOtherStateData%UnusedStates = SrcOtherStateData%UnusedStates END SUBROUTINE SeaSt_CopyOtherState - SUBROUTINE SeaSt_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SeaSt_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(SeaSt_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyOtherState' @@ -3829,12 +2724,6 @@ SUBROUTINE SeaSt_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SeaSt_DestroyOtherState SUBROUTINE SeaSt_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -3956,14 +2845,12 @@ SUBROUTINE SeaSt_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE SeaSt_CopyMisc - SUBROUTINE SeaSt_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SeaSt_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(SeaSt_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyMisc' @@ -3971,13 +2858,7 @@ SUBROUTINE SeaSt_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL SeaSt_Interp_DestroyMisc( MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_Interp_DestroyMisc( MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SeaSt_DestroyMisc @@ -4170,283 +3051,78 @@ SUBROUTINE SeaSt_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE SeaSt_UnPackMisc - - SUBROUTINE SeaSt_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SeaSt_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL Waves2_CopyParam( SrcParamData%Waves2, DstParamData%Waves2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ASSOCIATED(SrcParamData%WaveTime)) THEN - i1_l = LBOUND(SrcParamData%WaveTime,1) - i1_u = UBOUND(SrcParamData%WaveTime,1) - IF (.NOT. ASSOCIATED(DstParamData%WaveTime)) THEN - ALLOCATE(DstParamData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveTime = SrcParamData%WaveTime -ENDIF - DstParamData%WaveDT = SrcParamData%WaveDT - DstParamData%NGridPts = SrcParamData%NGridPts - DstParamData%NGrid = SrcParamData%NGrid - DstParamData%deltaGrid = SrcParamData%deltaGrid - DstParamData%X_HalfWidth = SrcParamData%X_HalfWidth - DstParamData%Y_HalfWidth = SrcParamData%Y_HalfWidth - DstParamData%Z_Depth = SrcParamData%Z_Depth - DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%NWaveElev = SrcParamData%NWaveElev -IF (ALLOCATED(SrcParamData%WaveElevxi)) THEN - i1_l = LBOUND(SrcParamData%WaveElevxi,1) - i1_u = UBOUND(SrcParamData%WaveElevxi,1) - IF (.NOT. ALLOCATED(DstParamData%WaveElevxi)) THEN - ALLOCATE(DstParamData%WaveElevxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveElevxi = SrcParamData%WaveElevxi -ENDIF -IF (ALLOCATED(SrcParamData%WaveElevyi)) THEN - i1_l = LBOUND(SrcParamData%WaveElevyi,1) - i1_u = UBOUND(SrcParamData%WaveElevyi,1) - IF (.NOT. ALLOCATED(DstParamData%WaveElevyi)) THEN - ALLOCATE(DstParamData%WaveElevyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveElevyi = SrcParamData%WaveElevyi -ENDIF -IF (ASSOCIATED(SrcParamData%WaveElev1)) THEN - i1_l = LBOUND(SrcParamData%WaveElev1,1) - i1_u = UBOUND(SrcParamData%WaveElev1,1) - i2_l = LBOUND(SrcParamData%WaveElev1,2) - i2_u = UBOUND(SrcParamData%WaveElev1,2) - i3_l = LBOUND(SrcParamData%WaveElev1,3) - i3_u = UBOUND(SrcParamData%WaveElev1,3) - IF (.NOT. ASSOCIATED(DstParamData%WaveElev1)) THEN - ALLOCATE(DstParamData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveElev1 = SrcParamData%WaveElev1 -ENDIF -IF (ASSOCIATED(SrcParamData%WaveElev2)) THEN - i1_l = LBOUND(SrcParamData%WaveElev2,1) - i1_u = UBOUND(SrcParamData%WaveElev2,1) - i2_l = LBOUND(SrcParamData%WaveElev2,2) - i2_u = UBOUND(SrcParamData%WaveElev2,2) - i3_l = LBOUND(SrcParamData%WaveElev2,3) - i3_u = UBOUND(SrcParamData%WaveElev2,3) - IF (.NOT. ASSOCIATED(DstParamData%WaveElev2)) THEN - ALLOCATE(DstParamData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveElev2 = SrcParamData%WaveElev2 -ENDIF -IF (ASSOCIATED(SrcParamData%PWaveDynP0)) THEN - i1_l = LBOUND(SrcParamData%PWaveDynP0,1) - i1_u = UBOUND(SrcParamData%PWaveDynP0,1) - i2_l = LBOUND(SrcParamData%PWaveDynP0,2) - i2_u = UBOUND(SrcParamData%PWaveDynP0,2) - i3_l = LBOUND(SrcParamData%PWaveDynP0,3) - i3_u = UBOUND(SrcParamData%PWaveDynP0,3) - IF (.NOT. ASSOCIATED(DstParamData%PWaveDynP0)) THEN - ALLOCATE(DstParamData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PWaveDynP0 = SrcParamData%PWaveDynP0 -ENDIF -IF (ASSOCIATED(SrcParamData%WaveDynP)) THEN - i1_l = LBOUND(SrcParamData%WaveDynP,1) - i1_u = UBOUND(SrcParamData%WaveDynP,1) - i2_l = LBOUND(SrcParamData%WaveDynP,2) - i2_u = UBOUND(SrcParamData%WaveDynP,2) - i3_l = LBOUND(SrcParamData%WaveDynP,3) - i3_u = UBOUND(SrcParamData%WaveDynP,3) - i4_l = LBOUND(SrcParamData%WaveDynP,4) - i4_u = UBOUND(SrcParamData%WaveDynP,4) - IF (.NOT. ASSOCIATED(DstParamData%WaveDynP)) THEN - ALLOCATE(DstParamData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveDynP = SrcParamData%WaveDynP -ENDIF -IF (ASSOCIATED(SrcParamData%WaveAcc)) THEN - i1_l = LBOUND(SrcParamData%WaveAcc,1) - i1_u = UBOUND(SrcParamData%WaveAcc,1) - i2_l = LBOUND(SrcParamData%WaveAcc,2) - i2_u = UBOUND(SrcParamData%WaveAcc,2) - i3_l = LBOUND(SrcParamData%WaveAcc,3) - i3_u = UBOUND(SrcParamData%WaveAcc,3) - i4_l = LBOUND(SrcParamData%WaveAcc,4) - i4_u = UBOUND(SrcParamData%WaveAcc,4) - i5_l = LBOUND(SrcParamData%WaveAcc,5) - i5_u = UBOUND(SrcParamData%WaveAcc,5) - IF (.NOT. ASSOCIATED(DstParamData%WaveAcc)) THEN - ALLOCATE(DstParamData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveAcc = SrcParamData%WaveAcc -ENDIF -IF (ASSOCIATED(SrcParamData%PWaveAcc0)) THEN - i1_l = LBOUND(SrcParamData%PWaveAcc0,1) - i1_u = UBOUND(SrcParamData%PWaveAcc0,1) - i2_l = LBOUND(SrcParamData%PWaveAcc0,2) - i2_u = UBOUND(SrcParamData%PWaveAcc0,2) - i3_l = LBOUND(SrcParamData%PWaveAcc0,3) - i3_u = UBOUND(SrcParamData%PWaveAcc0,3) - i4_l = LBOUND(SrcParamData%PWaveAcc0,4) - i4_u = UBOUND(SrcParamData%PWaveAcc0,4) - IF (.NOT. ASSOCIATED(DstParamData%PWaveAcc0)) THEN - ALLOCATE(DstParamData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PWaveAcc0 = SrcParamData%PWaveAcc0 -ENDIF -IF (ASSOCIATED(SrcParamData%WaveVel)) THEN - i1_l = LBOUND(SrcParamData%WaveVel,1) - i1_u = UBOUND(SrcParamData%WaveVel,1) - i2_l = LBOUND(SrcParamData%WaveVel,2) - i2_u = UBOUND(SrcParamData%WaveVel,2) - i3_l = LBOUND(SrcParamData%WaveVel,3) - i3_u = UBOUND(SrcParamData%WaveVel,3) - i4_l = LBOUND(SrcParamData%WaveVel,4) - i4_u = UBOUND(SrcParamData%WaveVel,4) - i5_l = LBOUND(SrcParamData%WaveVel,5) - i5_u = UBOUND(SrcParamData%WaveVel,5) - IF (.NOT. ASSOCIATED(DstParamData%WaveVel)) THEN - ALLOCATE(DstParamData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveVel = SrcParamData%WaveVel -ENDIF -IF (ASSOCIATED(SrcParamData%PWaveVel0)) THEN - i1_l = LBOUND(SrcParamData%PWaveVel0,1) - i1_u = UBOUND(SrcParamData%PWaveVel0,1) - i2_l = LBOUND(SrcParamData%PWaveVel0,2) - i2_u = UBOUND(SrcParamData%PWaveVel0,2) - i3_l = LBOUND(SrcParamData%PWaveVel0,3) - i3_u = UBOUND(SrcParamData%PWaveVel0,3) - i4_l = LBOUND(SrcParamData%PWaveVel0,4) - i4_u = UBOUND(SrcParamData%PWaveVel0,4) - IF (.NOT. ASSOCIATED(DstParamData%PWaveVel0)) THEN - ALLOCATE(DstParamData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PWaveVel0 = SrcParamData%PWaveVel0 -ENDIF -IF (ASSOCIATED(SrcParamData%WaveAccMCF)) THEN - i1_l = LBOUND(SrcParamData%WaveAccMCF,1) - i1_u = UBOUND(SrcParamData%WaveAccMCF,1) - i2_l = LBOUND(SrcParamData%WaveAccMCF,2) - i2_u = UBOUND(SrcParamData%WaveAccMCF,2) - i3_l = LBOUND(SrcParamData%WaveAccMCF,3) - i3_u = UBOUND(SrcParamData%WaveAccMCF,3) - i4_l = LBOUND(SrcParamData%WaveAccMCF,4) - i4_u = UBOUND(SrcParamData%WaveAccMCF,4) - i5_l = LBOUND(SrcParamData%WaveAccMCF,5) - i5_u = UBOUND(SrcParamData%WaveAccMCF,5) - IF (.NOT. ASSOCIATED(DstParamData%WaveAccMCF)) THEN - ALLOCATE(DstParamData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveAccMCF = SrcParamData%WaveAccMCF -ENDIF -IF (ASSOCIATED(SrcParamData%WaveDirArr)) THEN - i1_l = LBOUND(SrcParamData%WaveDirArr,1) - i1_u = UBOUND(SrcParamData%WaveDirArr,1) - IF (.NOT. ASSOCIATED(DstParamData%WaveDirArr)) THEN - ALLOCATE(DstParamData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveDirArr = SrcParamData%WaveDirArr -ENDIF -IF (ASSOCIATED(SrcParamData%WaveElevC0)) THEN - i1_l = LBOUND(SrcParamData%WaveElevC0,1) - i1_u = UBOUND(SrcParamData%WaveElevC0,1) - i2_l = LBOUND(SrcParamData%WaveElevC0,2) - i2_u = UBOUND(SrcParamData%WaveElevC0,2) - IF (.NOT. ASSOCIATED(DstParamData%WaveElevC0)) THEN - ALLOCATE(DstParamData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE SeaSt_UnPackMisc + + SUBROUTINE SeaSt_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SeaSt_ParameterType), INTENT(IN) :: SrcParamData + TYPE(SeaSt_ParameterType), INTENT(INOUT) :: DstParamData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_CopyParam' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL Waves2_CopyParam( SrcParamData%Waves2, DstParamData%Waves2, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstParamData%WaveTime => SrcParamData%WaveTime + DstParamData%WaveDT = SrcParamData%WaveDT + DstParamData%NGridPts = SrcParamData%NGridPts + DstParamData%NGrid = SrcParamData%NGrid + DstParamData%deltaGrid = SrcParamData%deltaGrid + DstParamData%X_HalfWidth = SrcParamData%X_HalfWidth + DstParamData%Y_HalfWidth = SrcParamData%Y_HalfWidth + DstParamData%Z_Depth = SrcParamData%Z_Depth + DstParamData%NStepWave = SrcParamData%NStepWave + DstParamData%NWaveElev = SrcParamData%NWaveElev +IF (ALLOCATED(SrcParamData%WaveElevxi)) THEN + i1_l = LBOUND(SrcParamData%WaveElevxi,1) + i1_u = UBOUND(SrcParamData%WaveElevxi,1) + IF (.NOT. ALLOCATED(DstParamData%WaveElevxi)) THEN + ALLOCATE(DstParamData%WaveElevxi(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstParamData%WaveElevC0 = SrcParamData%WaveElevC0 + DstParamData%WaveElevxi = SrcParamData%WaveElevxi ENDIF -IF (ASSOCIATED(SrcParamData%PWaveAccMCF0)) THEN - i1_l = LBOUND(SrcParamData%PWaveAccMCF0,1) - i1_u = UBOUND(SrcParamData%PWaveAccMCF0,1) - i2_l = LBOUND(SrcParamData%PWaveAccMCF0,2) - i2_u = UBOUND(SrcParamData%PWaveAccMCF0,2) - i3_l = LBOUND(SrcParamData%PWaveAccMCF0,3) - i3_u = UBOUND(SrcParamData%PWaveAccMCF0,3) - i4_l = LBOUND(SrcParamData%PWaveAccMCF0,4) - i4_u = UBOUND(SrcParamData%PWaveAccMCF0,4) - IF (.NOT. ASSOCIATED(DstParamData%PWaveAccMCF0)) THEN - ALLOCATE(DstParamData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) +IF (ALLOCATED(SrcParamData%WaveElevyi)) THEN + i1_l = LBOUND(SrcParamData%WaveElevyi,1) + i1_u = UBOUND(SrcParamData%WaveElevyi,1) + IF (.NOT. ALLOCATED(DstParamData%WaveElevyi)) THEN + ALLOCATE(DstParamData%WaveElevyi(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstParamData%PWaveAccMCF0 = SrcParamData%PWaveAccMCF0 + DstParamData%WaveElevyi = SrcParamData%WaveElevyi ENDIF + 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 + DstParamData%PWaveVel0 => SrcParamData%PWaveVel0 + DstParamData%WaveAccMCF => SrcParamData%WaveAccMCF + DstParamData%WaveDirArr => SrcParamData%WaveDirArr + DstParamData%WaveElevC0 => SrcParamData%WaveElevC0 + DstParamData%PWaveAccMCF0 => SrcParamData%PWaveAccMCF0 DstParamData%NWaveKin = SrcParamData%NWaveKin IF (ALLOCATED(SrcParamData%WaveKinxi)) THEN i1_l = LBOUND(SrcParamData%WaveKinxi,1) @@ -4518,14 +3194,12 @@ SUBROUTINE SeaSt_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE SeaSt_CopyParam - SUBROUTINE SeaSt_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SeaSt_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(SeaSt_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyParam' @@ -4533,85 +3207,27 @@ SUBROUTINE SeaSt_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL Waves2_DestroyParam( ParamData%Waves2, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL Waves2_DestroyParam( ParamData%Waves2, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ASSOCIATED(ParamData%WaveTime)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%WaveTime) - ParamData%WaveTime => NULL() -ENDIF +NULLIFY(ParamData%WaveTime) IF (ALLOCATED(ParamData%WaveElevxi)) THEN DEALLOCATE(ParamData%WaveElevxi) ENDIF IF (ALLOCATED(ParamData%WaveElevyi)) THEN DEALLOCATE(ParamData%WaveElevyi) ENDIF -IF (ASSOCIATED(ParamData%WaveElev1)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%WaveElev1) - ParamData%WaveElev1 => NULL() -ENDIF -IF (ASSOCIATED(ParamData%WaveElev2)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%WaveElev2) - ParamData%WaveElev2 => NULL() -ENDIF -IF (ASSOCIATED(ParamData%PWaveDynP0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%PWaveDynP0) - ParamData%PWaveDynP0 => NULL() -ENDIF -IF (ASSOCIATED(ParamData%WaveDynP)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%WaveDynP) - ParamData%WaveDynP => NULL() -ENDIF -IF (ASSOCIATED(ParamData%WaveAcc)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%WaveAcc) - ParamData%WaveAcc => NULL() -ENDIF -IF (ASSOCIATED(ParamData%PWaveAcc0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%PWaveAcc0) - ParamData%PWaveAcc0 => NULL() -ENDIF -IF (ASSOCIATED(ParamData%WaveVel)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%WaveVel) - ParamData%WaveVel => NULL() -ENDIF -IF (ASSOCIATED(ParamData%PWaveVel0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%PWaveVel0) - ParamData%PWaveVel0 => NULL() -ENDIF -IF (ASSOCIATED(ParamData%WaveAccMCF)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%WaveAccMCF) - ParamData%WaveAccMCF => NULL() -ENDIF -IF (ASSOCIATED(ParamData%WaveDirArr)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%WaveDirArr) - ParamData%WaveDirArr => NULL() -ENDIF -IF (ASSOCIATED(ParamData%WaveElevC0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%WaveElevC0) - ParamData%WaveElevC0 => NULL() -ENDIF -IF (ASSOCIATED(ParamData%PWaveAccMCF0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(ParamData%PWaveAccMCF0) - ParamData%PWaveAccMCF0 => NULL() -ENDIF +NULLIFY(ParamData%WaveElev1) +NULLIFY(ParamData%WaveElev2) +NULLIFY(ParamData%PWaveDynP0) +NULLIFY(ParamData%WaveDynP) +NULLIFY(ParamData%WaveAcc) +NULLIFY(ParamData%PWaveAcc0) +NULLIFY(ParamData%WaveVel) +NULLIFY(ParamData%PWaveVel0) +NULLIFY(ParamData%WaveAccMCF) +NULLIFY(ParamData%WaveDirArr) +NULLIFY(ParamData%WaveElevC0) +NULLIFY(ParamData%PWaveAccMCF0) IF (ALLOCATED(ParamData%WaveKinxi)) THEN DEALLOCATE(ParamData%WaveKinxi) ENDIF @@ -4623,14 +3239,14 @@ SUBROUTINE SeaSt_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) ENDIF - CALL SeaSt_Interp_DestroyParam( ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_Interp_DestroyParam( ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_WaveField_Destroyseast_wavefieldtype( ParamData%WaveField, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SeaSt_WaveField_DestroySeaSt_WaveFieldType( ParamData%WaveField, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SeaSt_DestroyParam @@ -4687,11 +3303,6 @@ SUBROUTINE SeaSt_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ASSOCIATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF Db_BufSz = Db_BufSz + 1 ! WaveDT Int_BufSz = Int_BufSz + 1 ! NGridPts Int_BufSz = Int_BufSz + SIZE(InData%NGrid) ! NGrid @@ -4710,66 +3321,6 @@ SUBROUTINE SeaSt_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IF ( ALLOCATED(InData%WaveElevyi) ) THEN Int_BufSz = Int_BufSz + 2*1 ! WaveElevyi upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveElevyi) ! WaveElevyi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev1 allocated yes/no - IF ( ASSOCIATED(InData%WaveElev1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElev1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev1) ! WaveElev1 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev2 allocated yes/no - IF ( ASSOCIATED(InData%WaveElev2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElev2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev2) ! WaveElev2 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveDynP0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveDynP0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PWaveDynP0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveDynP0) ! PWaveDynP0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP allocated yes/no - IF ( ASSOCIATED(InData%WaveDynP) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! WaveDynP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP) ! WaveDynP - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc allocated yes/no - IF ( ASSOCIATED(InData%WaveAcc) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveAcc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc) ! WaveAcc - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveAcc0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveAcc0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveAcc0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveAcc0) ! PWaveAcc0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel allocated yes/no - IF ( ASSOCIATED(InData%WaveVel) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel) ! WaveVel - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveVel0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveVel0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveVel0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveVel0) ! PWaveVel0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAccMCF allocated yes/no - IF ( ASSOCIATED(InData%WaveAccMCF) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveAccMCF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAccMCF) ! WaveAccMCF - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDirArr allocated yes/no - IF ( ASSOCIATED(InData%WaveDirArr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveDirArr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDirArr) ! WaveDirArr - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevC0 allocated yes/no - IF ( ASSOCIATED(InData%WaveElevC0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevC0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC0) ! WaveElevC0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveAccMCF0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveAccMCF0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveAccMCF0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveAccMCF0) ! PWaveAccMCF0 END IF Int_BufSz = Int_BufSz + 1 ! NWaveKin Int_BufSz = Int_BufSz + 1 ! WaveKinxi allocated yes/no @@ -4795,7 +3346,7 @@ SUBROUTINE SeaSt_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4838,7 +3389,7 @@ SUBROUTINE SeaSt_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! WaveField: size of buffers for each call to pack subtype - CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField + CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4909,21 +3460,6 @@ SUBROUTINE SeaSt_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IF ( .NOT. ASSOCIATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF DbKiBuf(Db_Xferred) = InData%WaveDT Db_Xferred = Db_Xferred + 1 IntKiBuf(Int_Xferred) = InData%NGridPts @@ -4967,348 +3503,13 @@ SUBROUTINE SeaSt_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElevyi,1), UBOUND(InData%WaveElevyi,1) - ReKiBuf(Re_Xferred) = InData%WaveElevyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveElev1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElev1,3), UBOUND(InData%WaveElev1,3) - DO i2 = LBOUND(InData%WaveElev1,2), UBOUND(InData%WaveElev1,2) - DO i1 = LBOUND(InData%WaveElev1,1), UBOUND(InData%WaveElev1,1) - ReKiBuf(Re_Xferred) = InData%WaveElev1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveElev2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElev2,3), UBOUND(InData%WaveElev2,3) - DO i2 = LBOUND(InData%WaveElev2,2), UBOUND(InData%WaveElev2,2) - DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) - ReKiBuf(Re_Xferred) = InData%WaveElev2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveDynP0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PWaveDynP0,3), UBOUND(InData%PWaveDynP0,3) - DO i2 = LBOUND(InData%PWaveDynP0,2), UBOUND(InData%PWaveDynP0,2) - DO i1 = LBOUND(InData%PWaveDynP0,1), UBOUND(InData%PWaveDynP0,1) - ReKiBuf(Re_Xferred) = InData%PWaveDynP0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveDynP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%WaveDynP,4), UBOUND(InData%WaveDynP,4) - DO i3 = LBOUND(InData%WaveDynP,3), UBOUND(InData%WaveDynP,3) - DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) - DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveAcc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveAcc,5), UBOUND(InData%WaveAcc,5) - DO i4 = LBOUND(InData%WaveAcc,4), UBOUND(InData%WaveAcc,4) - DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) - DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) - DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveAcc0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveAcc0,4), UBOUND(InData%PWaveAcc0,4) - DO i3 = LBOUND(InData%PWaveAcc0,3), UBOUND(InData%PWaveAcc0,3) - DO i2 = LBOUND(InData%PWaveAcc0,2), UBOUND(InData%PWaveAcc0,2) - DO i1 = LBOUND(InData%PWaveAcc0,1), UBOUND(InData%PWaveAcc0,1) - ReKiBuf(Re_Xferred) = InData%PWaveAcc0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveVel,5), UBOUND(InData%WaveVel,5) - DO i4 = LBOUND(InData%WaveVel,4), UBOUND(InData%WaveVel,4) - DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) - DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) - DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) - ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveVel0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveVel0,4), UBOUND(InData%PWaveVel0,4) - DO i3 = LBOUND(InData%PWaveVel0,3), UBOUND(InData%PWaveVel0,3) - DO i2 = LBOUND(InData%PWaveVel0,2), UBOUND(InData%PWaveVel0,2) - DO i1 = LBOUND(InData%PWaveVel0,1), UBOUND(InData%PWaveVel0,1) - ReKiBuf(Re_Xferred) = InData%PWaveVel0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveAccMCF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveAccMCF,5), UBOUND(InData%WaveAccMCF,5) - DO i4 = LBOUND(InData%WaveAccMCF,4), UBOUND(InData%WaveAccMCF,4) - DO i3 = LBOUND(InData%WaveAccMCF,3), UBOUND(InData%WaveAccMCF,3) - DO i2 = LBOUND(InData%WaveAccMCF,2), UBOUND(InData%WaveAccMCF,2) - DO i1 = LBOUND(InData%WaveAccMCF,1), UBOUND(InData%WaveAccMCF,1) - ReKiBuf(Re_Xferred) = InData%WaveAccMCF(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveDirArr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDirArr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) - ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveElevC0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) - DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveAccMCF0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,4) + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevyi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevyi,1) Int_Xferred = Int_Xferred + 2 - DO i4 = LBOUND(InData%PWaveAccMCF0,4), UBOUND(InData%PWaveAccMCF0,4) - DO i3 = LBOUND(InData%PWaveAccMCF0,3), UBOUND(InData%PWaveAccMCF0,3) - DO i2 = LBOUND(InData%PWaveAccMCF0,2), UBOUND(InData%PWaveAccMCF0,2) - DO i1 = LBOUND(InData%PWaveAccMCF0,1), UBOUND(InData%PWaveAccMCF0,1) - ReKiBuf(Re_Xferred) = InData%PWaveAccMCF0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO + DO i1 = LBOUND(InData%WaveElevyi,1), UBOUND(InData%WaveElevyi,1) + ReKiBuf(Re_Xferred) = InData%WaveElevyi(i1) + Re_Xferred = Re_Xferred + 1 END DO END IF IntKiBuf(Int_Xferred) = InData%NWaveKin @@ -5375,7 +3576,7 @@ SUBROUTINE SeaSt_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5453,7 +3654,7 @@ SUBROUTINE SeaSt_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL SeaSt_WaveField_Packseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField + CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5554,24 +3755,7 @@ SUBROUTINE SeaSt_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF + NULLIFY(OutData%WaveTime) OutData%WaveDT = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 OutData%NGridPts = IntKiBuf(Int_Xferred) @@ -5634,377 +3818,18 @@ SUBROUTINE SeaSt_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElev1)) DEALLOCATE(OutData%WaveElev1) - ALLOCATE(OutData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElev1,3), UBOUND(OutData%WaveElev1,3) - DO i2 = LBOUND(OutData%WaveElev1,2), UBOUND(OutData%WaveElev1,2) - DO i1 = LBOUND(OutData%WaveElev1,1), UBOUND(OutData%WaveElev1,1) - OutData%WaveElev1(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElev2)) DEALLOCATE(OutData%WaveElev2) - ALLOCATE(OutData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElev2,3), UBOUND(OutData%WaveElev2,3) - DO i2 = LBOUND(OutData%WaveElev2,2), UBOUND(OutData%WaveElev2,2) - DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) - OutData%WaveElev2(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveDynP0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveDynP0)) DEALLOCATE(OutData%PWaveDynP0) - ALLOCATE(OutData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PWaveDynP0,3), UBOUND(OutData%PWaveDynP0,3) - DO i2 = LBOUND(OutData%PWaveDynP0,2), UBOUND(OutData%PWaveDynP0,2) - DO i1 = LBOUND(OutData%PWaveDynP0,1), UBOUND(OutData%PWaveDynP0,1) - OutData%PWaveDynP0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveDynP)) DEALLOCATE(OutData%WaveDynP) - ALLOCATE(OutData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%WaveDynP,4), UBOUND(OutData%WaveDynP,4) - DO i3 = LBOUND(OutData%WaveDynP,3), UBOUND(OutData%WaveDynP,3) - DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) - DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) - OutData%WaveDynP(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveAcc)) DEALLOCATE(OutData%WaveAcc) - ALLOCATE(OutData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAcc,5), UBOUND(OutData%WaveAcc,5) - DO i4 = LBOUND(OutData%WaveAcc,4), UBOUND(OutData%WaveAcc,4) - DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) - DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) - DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) - OutData%WaveAcc(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAcc0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveAcc0)) DEALLOCATE(OutData%PWaveAcc0) - ALLOCATE(OutData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveAcc0,4), UBOUND(OutData%PWaveAcc0,4) - DO i3 = LBOUND(OutData%PWaveAcc0,3), UBOUND(OutData%PWaveAcc0,3) - DO i2 = LBOUND(OutData%PWaveAcc0,2), UBOUND(OutData%PWaveAcc0,2) - DO i1 = LBOUND(OutData%PWaveAcc0,1), UBOUND(OutData%PWaveAcc0,1) - OutData%PWaveAcc0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveVel)) DEALLOCATE(OutData%WaveVel) - ALLOCATE(OutData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveVel,5), UBOUND(OutData%WaveVel,5) - DO i4 = LBOUND(OutData%WaveVel,4), UBOUND(OutData%WaveVel,4) - DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) - DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) - DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) - OutData%WaveVel(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveVel0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveVel0)) DEALLOCATE(OutData%PWaveVel0) - ALLOCATE(OutData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveVel0,4), UBOUND(OutData%PWaveVel0,4) - DO i3 = LBOUND(OutData%PWaveVel0,3), UBOUND(OutData%PWaveVel0,3) - DO i2 = LBOUND(OutData%PWaveVel0,2), UBOUND(OutData%PWaveVel0,2) - DO i1 = LBOUND(OutData%PWaveVel0,1), UBOUND(OutData%PWaveVel0,1) - OutData%PWaveVel0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAccMCF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveAccMCF)) DEALLOCATE(OutData%WaveAccMCF) - ALLOCATE(OutData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAccMCF,5), UBOUND(OutData%WaveAccMCF,5) - DO i4 = LBOUND(OutData%WaveAccMCF,4), UBOUND(OutData%WaveAccMCF,4) - DO i3 = LBOUND(OutData%WaveAccMCF,3), UBOUND(OutData%WaveAccMCF,3) - DO i2 = LBOUND(OutData%WaveAccMCF,2), UBOUND(OutData%WaveAccMCF,2) - DO i1 = LBOUND(OutData%WaveAccMCF,1), UBOUND(OutData%WaveAccMCF,1) - OutData%WaveAccMCF(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveDirArr)) DEALLOCATE(OutData%WaveDirArr) - ALLOCATE(OutData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) - OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElevC0)) DEALLOCATE(OutData%WaveElevC0) - ALLOCATE(OutData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) - DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) - OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAccMCF0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveAccMCF0)) DEALLOCATE(OutData%PWaveAccMCF0) - ALLOCATE(OutData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveAccMCF0,4), UBOUND(OutData%PWaveAccMCF0,4) - DO i3 = LBOUND(OutData%PWaveAccMCF0,3), UBOUND(OutData%PWaveAccMCF0,3) - DO i2 = LBOUND(OutData%PWaveAccMCF0,2), UBOUND(OutData%PWaveAccMCF0,2) - DO i1 = LBOUND(OutData%PWaveAccMCF0,1), UBOUND(OutData%PWaveAccMCF0,1) - OutData%PWaveAccMCF0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF + NULLIFY(OutData%WaveElev1) + NULLIFY(OutData%WaveElev2) + NULLIFY(OutData%PWaveDynP0) + NULLIFY(OutData%WaveDynP) + NULLIFY(OutData%WaveAcc) + NULLIFY(OutData%PWaveAcc0) + NULLIFY(OutData%WaveVel) + NULLIFY(OutData%PWaveVel0) + NULLIFY(OutData%WaveAccMCF) + NULLIFY(OutData%WaveDirArr) + NULLIFY(OutData%WaveElevC0) + NULLIFY(OutData%PWaveAccMCF0) OutData%NWaveKin = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinxi not allocated @@ -6114,7 +3939,7 @@ SUBROUTINE SeaSt_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6216,7 +4041,7 @@ SUBROUTINE SeaSt_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SeaSt_WaveField_Unpackseast_wavefieldtype( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField + CALL SeaSt_WaveField_UnpackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6242,14 +4067,12 @@ SUBROUTINE SeaSt_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs DstInputData%DummyInput = SrcInputData%DummyInput END SUBROUTINE SeaSt_CopyInput - SUBROUTINE SeaSt_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SeaSt_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(SeaSt_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyInput' @@ -6257,12 +4080,6 @@ SUBROUTINE SeaSt_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SeaSt_DestroyInput SUBROUTINE SeaSt_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -6391,14 +4208,12 @@ SUBROUTINE SeaSt_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er ENDIF END SUBROUTINE SeaSt_CopyOutput - SUBROUTINE SeaSt_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SeaSt_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(SeaSt_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyOutput' @@ -6406,12 +4221,6 @@ SUBROUTINE SeaSt_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%WriteOutput)) THEN DEALLOCATE(OutputData%WriteOutput) ENDIF diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index 10dcf8c2a1..c5015bbfae 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -88,9 +88,6 @@ SUBROUTINE Waves2_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, E INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyInitInput' @@ -105,44 +102,9 @@ SUBROUTINE Waves2_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir -IF (ASSOCIATED(SrcInitInputData%WaveDirArr)) THEN - i1_l = LBOUND(SrcInitInputData%WaveDirArr,1) - i1_u = UBOUND(SrcInitInputData%WaveDirArr,1) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveDirArr)) THEN - ALLOCATE(DstInitInputData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveDirArr = SrcInitInputData%WaveDirArr -ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveElevC0)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevC0,1) - i1_u = UBOUND(SrcInitInputData%WaveElevC0,1) - i2_l = LBOUND(SrcInitInputData%WaveElevC0,2) - i2_u = UBOUND(SrcInitInputData%WaveElevC0,2) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveElevC0)) THEN - ALLOCATE(DstInitInputData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevC0 = SrcInitInputData%WaveElevC0 -ENDIF -IF (ASSOCIATED(SrcInitInputData%WaveTime)) THEN - i1_l = LBOUND(SrcInitInputData%WaveTime,1) - i1_u = UBOUND(SrcInitInputData%WaveTime,1) - IF (.NOT. ASSOCIATED(DstInitInputData%WaveTime)) THEN - ALLOCATE(DstInitInputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveTime = SrcInitInputData%WaveTime -ENDIF + DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr + DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 + DstInitInputData%WaveTime => SrcInitInputData%WaveTime DstInitInputData%nGrid = SrcInitInputData%nGrid DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid @@ -190,14 +152,12 @@ SUBROUTINE Waves2_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS END SUBROUTINE Waves2_CopyInitInput - SUBROUTINE Waves2_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Waves2_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(Waves2_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyInitInput' @@ -205,27 +165,9 @@ SUBROUTINE Waves2_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ASSOCIATED(InitInputData%WaveDirArr)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveDirArr) - InitInputData%WaveDirArr => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%WaveElevC0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveElevC0) - InitInputData%WaveElevC0 => NULL() -ENDIF -IF (ASSOCIATED(InitInputData%WaveTime)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitInputData%WaveTime) - InitInputData%WaveTime => NULL() -ENDIF +NULLIFY(InitInputData%WaveDirArr) +NULLIFY(InitInputData%WaveElevC0) +NULLIFY(InitInputData%WaveTime) IF (ALLOCATED(InitInputData%WaveKinGridxi)) THEN DEALLOCATE(InitInputData%WaveKinGridxi) ENDIF @@ -280,21 +222,6 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Re_BufSz = Re_BufSz + 1 ! WaveDOmega Int_BufSz = Int_BufSz + 1 ! WaveStMod Int_BufSz = Int_BufSz + 1 ! WaveMultiDir - Int_BufSz = Int_BufSz + 1 ! WaveDirArr allocated yes/no - IF ( ASSOCIATED(InData%WaveDirArr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveDirArr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDirArr) ! WaveDirArr - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevC0 allocated yes/no - IF ( ASSOCIATED(InData%WaveElevC0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevC0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC0) ! WaveElevC0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ASSOCIATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF Int_BufSz = Int_BufSz + SIZE(InData%nGrid) ! nGrid Int_BufSz = Int_BufSz + 1 ! NWaveElevGrid Int_BufSz = Int_BufSz + 1 ! NWaveKinGrid @@ -362,56 +289,6 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ASSOCIATED(InData%WaveDirArr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDirArr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) - ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveElevC0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) - DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF DO i1 = LBOUND(InData%nGrid,1), UBOUND(InData%nGrid,1) IntKiBuf(Int_Xferred) = InData%nGrid(i1) Int_Xferred = Int_Xferred + 1 @@ -494,9 +371,6 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: i INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackInitInput' @@ -526,65 +400,9 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Xferred = Int_Xferred + 1 OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveDirArr)) DEALLOCATE(OutData%WaveDirArr) - ALLOCATE(OutData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) - OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElevC0)) DEALLOCATE(OutData%WaveElevC0) - ALLOCATE(OutData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) - DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) - OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF + NULLIFY(OutData%WaveDirArr) + NULLIFY(OutData%WaveElevC0) + NULLIFY(OutData%WaveTime) i1_l = LBOUND(OutData%nGrid,1) i1_u = UBOUND(OutData%nGrid,1) DO i1 = LBOUND(OutData%nGrid,1), UBOUND(OutData%nGrid,1) @@ -798,32 +616,15 @@ SUBROUTINE Waves2_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode END IF DstInitOutputData%WaveVel2S = SrcInitOutputData%WaveVel2S ENDIF -IF (ASSOCIATED(SrcInitOutputData%WaveElev2)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElev2,1) - i1_u = UBOUND(SrcInitOutputData%WaveElev2,1) - i2_l = LBOUND(SrcInitOutputData%WaveElev2,2) - i2_u = UBOUND(SrcInitOutputData%WaveElev2,2) - i3_l = LBOUND(SrcInitOutputData%WaveElev2,3) - i3_u = UBOUND(SrcInitOutputData%WaveElev2,3) - IF (.NOT. ASSOCIATED(DstInitOutputData%WaveElev2)) THEN - ALLOCATE(DstInitOutputData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElev2 = SrcInitOutputData%WaveElev2 -ENDIF + DstInitOutputData%WaveElev2 => SrcInitOutputData%WaveElev2 END SUBROUTINE Waves2_CopyInitOutput - SUBROUTINE Waves2_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Waves2_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(Waves2_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyInitOutput' @@ -831,12 +632,6 @@ SUBROUTINE Waves2_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%WaveAcc2D)) THEN DEALLOCATE(InitOutputData%WaveAcc2D) ENDIF @@ -855,11 +650,7 @@ SUBROUTINE Waves2_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATE IF (ALLOCATED(InitOutputData%WaveVel2S)) THEN DEALLOCATE(InitOutputData%WaveVel2S) ENDIF -IF (ASSOCIATED(InitOutputData%WaveElev2)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%WaveElev2) - InitOutputData%WaveElev2 => NULL() -ENDIF +NULLIFY(InitOutputData%WaveElev2) END SUBROUTINE Waves2_DestroyInitOutput SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -927,11 +718,6 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*5 ! WaveVel2S upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveVel2S) ! WaveVel2S END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev2 allocated yes/no - IF ( ASSOCIATED(InData%WaveElev2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElev2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev2) ! WaveElev2 - END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -1159,31 +945,6 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO END DO END IF - IF ( .NOT. ASSOCIATED(InData%WaveElev2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElev2,3), UBOUND(InData%WaveElev2,3) - DO i2 = LBOUND(InData%WaveElev2,2), UBOUND(InData%WaveElev2,2) - DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) - ReKiBuf(Re_Xferred) = InData%WaveElev2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF END SUBROUTINE Waves2_PackInitOutput SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1435,34 +1196,7 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElev2)) DEALLOCATE(OutData%WaveElev2) - ALLOCATE(OutData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElev2,3), UBOUND(OutData%WaveElev2,3) - DO i2 = LBOUND(OutData%WaveElev2,2), UBOUND(OutData%WaveElev2,2) - DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) - OutData%WaveElev2(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF + NULLIFY(OutData%WaveElev2) END SUBROUTINE Waves2_UnPackInitOutput SUBROUTINE Waves2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1483,14 +1217,12 @@ SUBROUTINE Waves2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%WvSumQTFF = SrcParamData%WvSumQTFF END SUBROUTINE Waves2_CopyParam - SUBROUTINE Waves2_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Waves2_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(Waves2_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyParam' @@ -1498,12 +1230,6 @@ SUBROUTINE Waves2_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE Waves2_DestroyParam SUBROUTINE Waves2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index e305d6f2f5..2384e74cb7 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -119,10 +119,6 @@ SUBROUTINE Waves_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyInitInput' @@ -234,14 +230,12 @@ SUBROUTINE Waves_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY END SUBROUTINE Waves_CopyInitInput - SUBROUTINE Waves_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Waves_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(Waves_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyInitInput' @@ -249,12 +243,6 @@ SUBROUTINE Waves_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%WaveKinGridxi)) THEN DEALLOCATE(InitInputData%WaveKinGridxi) ENDIF @@ -270,7 +258,7 @@ SUBROUTINE Waves_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoi IF (ALLOCATED(InitInputData%CurrVyi)) THEN DEALLOCATE(InitInputData%CurrVyi) ENDIF - CALL NWTC_Library_Destroynwtc_randomnumber_parametertype( InitInputData%RNG, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyNWTC_RandomNumber_ParameterType( InitInputData%RNG, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Waves_DestroyInitInput @@ -367,7 +355,7 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Re_BufSz = Re_BufSz + 1 ! PCurrVyiPz0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! RNG: size of buffers for each call to pack subtype - CALL NWTC_Library_Packnwtc_randomnumber_parametertype( Re_Buf, Db_Buf, Int_Buf, InData%RNG, ErrStat2, ErrMsg2, .TRUE. ) ! RNG + CALL NWTC_Library_PackNWTC_RandomNumber_ParameterType( Re_Buf, Db_Buf, Int_Buf, InData%RNG, ErrStat2, ErrMsg2, .TRUE. ) ! RNG CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -570,7 +558,7 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%PCurrVyiPz0 Re_Xferred = Re_Xferred + 1 - CALL NWTC_Library_Packnwtc_randomnumber_parametertype( Re_Buf, Db_Buf, Int_Buf, InData%RNG, ErrStat2, ErrMsg2, OnlySize ) ! RNG + CALL NWTC_Library_PackNWTC_RandomNumber_ParameterType( Re_Buf, Db_Buf, Int_Buf, InData%RNG, ErrStat2, ErrMsg2, OnlySize ) ! RNG CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -632,10 +620,6 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackInitInput' @@ -852,7 +836,7 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpacknwtc_randomnumber_parametertype( Re_Buf, Db_Buf, Int_Buf, OutData%RNG, ErrStat2, ErrMsg2 ) ! RNG + CALL NWTC_Library_UnpackNWTC_RandomNumber_ParameterType( Re_Buf, Db_Buf, Int_Buf, OutData%RNG, ErrStat2, ErrMsg2 ) ! RNG CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -898,20 +882,7 @@ SUBROUTINE Waves_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ! ErrStat = ErrID_None ErrMsg = "" -IF (ASSOCIATED(SrcInitOutputData%WaveElevC0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElevC0,1) - i1_u = UBOUND(SrcInitOutputData%WaveElevC0,1) - i2_l = LBOUND(SrcInitOutputData%WaveElevC0,2) - i2_u = UBOUND(SrcInitOutputData%WaveElevC0,2) - IF (.NOT. ASSOCIATED(DstInitOutputData%WaveElevC0)) THEN - ALLOCATE(DstInitOutputData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElevC0 = SrcInitOutputData%WaveElevC0 -ENDIF + DstInitOutputData%WaveElevC0 => SrcInitOutputData%WaveElevC0 IF (ALLOCATED(SrcInitOutputData%WaveElevC)) THEN i1_l = LBOUND(SrcInitOutputData%WaveElevC,1) i1_u = UBOUND(SrcInitOutputData%WaveElevC,1) @@ -928,186 +899,20 @@ SUBROUTINE Waves_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, END IF DstInitOutputData%WaveElevC = SrcInitOutputData%WaveElevC ENDIF -IF (ASSOCIATED(SrcInitOutputData%WaveDirArr)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveDirArr,1) - i1_u = UBOUND(SrcInitOutputData%WaveDirArr,1) - IF (.NOT. ASSOCIATED(DstInitOutputData%WaveDirArr)) THEN - ALLOCATE(DstInitOutputData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveDirArr = SrcInitOutputData%WaveDirArr -ENDIF + DstInitOutputData%WaveDirArr => SrcInitOutputData%WaveDirArr DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega -IF (ASSOCIATED(SrcInitOutputData%WaveDynP)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveDynP,1) - i1_u = UBOUND(SrcInitOutputData%WaveDynP,1) - i2_l = LBOUND(SrcInitOutputData%WaveDynP,2) - i2_u = UBOUND(SrcInitOutputData%WaveDynP,2) - i3_l = LBOUND(SrcInitOutputData%WaveDynP,3) - i3_u = UBOUND(SrcInitOutputData%WaveDynP,3) - i4_l = LBOUND(SrcInitOutputData%WaveDynP,4) - i4_u = UBOUND(SrcInitOutputData%WaveDynP,4) - IF (.NOT. ASSOCIATED(DstInitOutputData%WaveDynP)) THEN - ALLOCATE(DstInitOutputData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveDynP = SrcInitOutputData%WaveDynP -ENDIF -IF (ASSOCIATED(SrcInitOutputData%WaveAcc)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveAcc,1) - i1_u = UBOUND(SrcInitOutputData%WaveAcc,1) - i2_l = LBOUND(SrcInitOutputData%WaveAcc,2) - i2_u = UBOUND(SrcInitOutputData%WaveAcc,2) - i3_l = LBOUND(SrcInitOutputData%WaveAcc,3) - i3_u = UBOUND(SrcInitOutputData%WaveAcc,3) - i4_l = LBOUND(SrcInitOutputData%WaveAcc,4) - i4_u = UBOUND(SrcInitOutputData%WaveAcc,4) - i5_l = LBOUND(SrcInitOutputData%WaveAcc,5) - i5_u = UBOUND(SrcInitOutputData%WaveAcc,5) - IF (.NOT. ASSOCIATED(DstInitOutputData%WaveAcc)) THEN - ALLOCATE(DstInitOutputData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveAcc = SrcInitOutputData%WaveAcc -ENDIF -IF (ASSOCIATED(SrcInitOutputData%WaveAccMCF)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveAccMCF,1) - i1_u = UBOUND(SrcInitOutputData%WaveAccMCF,1) - i2_l = LBOUND(SrcInitOutputData%WaveAccMCF,2) - i2_u = UBOUND(SrcInitOutputData%WaveAccMCF,2) - i3_l = LBOUND(SrcInitOutputData%WaveAccMCF,3) - i3_u = UBOUND(SrcInitOutputData%WaveAccMCF,3) - i4_l = LBOUND(SrcInitOutputData%WaveAccMCF,4) - i4_u = UBOUND(SrcInitOutputData%WaveAccMCF,4) - i5_l = LBOUND(SrcInitOutputData%WaveAccMCF,5) - i5_u = UBOUND(SrcInitOutputData%WaveAccMCF,5) - IF (.NOT. ASSOCIATED(DstInitOutputData%WaveAccMCF)) THEN - ALLOCATE(DstInitOutputData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveAccMCF = SrcInitOutputData%WaveAccMCF -ENDIF -IF (ASSOCIATED(SrcInitOutputData%WaveVel)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveVel,1) - i1_u = UBOUND(SrcInitOutputData%WaveVel,1) - i2_l = LBOUND(SrcInitOutputData%WaveVel,2) - i2_u = UBOUND(SrcInitOutputData%WaveVel,2) - i3_l = LBOUND(SrcInitOutputData%WaveVel,3) - i3_u = UBOUND(SrcInitOutputData%WaveVel,3) - i4_l = LBOUND(SrcInitOutputData%WaveVel,4) - i4_u = UBOUND(SrcInitOutputData%WaveVel,4) - i5_l = LBOUND(SrcInitOutputData%WaveVel,5) - i5_u = UBOUND(SrcInitOutputData%WaveVel,5) - IF (.NOT. ASSOCIATED(DstInitOutputData%WaveVel)) THEN - ALLOCATE(DstInitOutputData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveVel = SrcInitOutputData%WaveVel -ENDIF -IF (ASSOCIATED(SrcInitOutputData%PWaveDynP0)) THEN - i1_l = LBOUND(SrcInitOutputData%PWaveDynP0,1) - i1_u = UBOUND(SrcInitOutputData%PWaveDynP0,1) - i2_l = LBOUND(SrcInitOutputData%PWaveDynP0,2) - i2_u = UBOUND(SrcInitOutputData%PWaveDynP0,2) - i3_l = LBOUND(SrcInitOutputData%PWaveDynP0,3) - i3_u = UBOUND(SrcInitOutputData%PWaveDynP0,3) - IF (.NOT. ASSOCIATED(DstInitOutputData%PWaveDynP0)) THEN - ALLOCATE(DstInitOutputData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%PWaveDynP0 = SrcInitOutputData%PWaveDynP0 -ENDIF -IF (ASSOCIATED(SrcInitOutputData%PWaveAcc0)) THEN - i1_l = LBOUND(SrcInitOutputData%PWaveAcc0,1) - i1_u = UBOUND(SrcInitOutputData%PWaveAcc0,1) - i2_l = LBOUND(SrcInitOutputData%PWaveAcc0,2) - i2_u = UBOUND(SrcInitOutputData%PWaveAcc0,2) - i3_l = LBOUND(SrcInitOutputData%PWaveAcc0,3) - i3_u = UBOUND(SrcInitOutputData%PWaveAcc0,3) - i4_l = LBOUND(SrcInitOutputData%PWaveAcc0,4) - i4_u = UBOUND(SrcInitOutputData%PWaveAcc0,4) - IF (.NOT. ASSOCIATED(DstInitOutputData%PWaveAcc0)) THEN - ALLOCATE(DstInitOutputData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%PWaveAcc0 = SrcInitOutputData%PWaveAcc0 -ENDIF -IF (ASSOCIATED(SrcInitOutputData%PWaveAccMCF0)) THEN - i1_l = LBOUND(SrcInitOutputData%PWaveAccMCF0,1) - i1_u = UBOUND(SrcInitOutputData%PWaveAccMCF0,1) - i2_l = LBOUND(SrcInitOutputData%PWaveAccMCF0,2) - i2_u = UBOUND(SrcInitOutputData%PWaveAccMCF0,2) - i3_l = LBOUND(SrcInitOutputData%PWaveAccMCF0,3) - i3_u = UBOUND(SrcInitOutputData%PWaveAccMCF0,3) - i4_l = LBOUND(SrcInitOutputData%PWaveAccMCF0,4) - i4_u = UBOUND(SrcInitOutputData%PWaveAccMCF0,4) - IF (.NOT. ASSOCIATED(DstInitOutputData%PWaveAccMCF0)) THEN - ALLOCATE(DstInitOutputData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%PWaveAccMCF0 = SrcInitOutputData%PWaveAccMCF0 -ENDIF -IF (ASSOCIATED(SrcInitOutputData%PWaveVel0)) THEN - i1_l = LBOUND(SrcInitOutputData%PWaveVel0,1) - i1_u = UBOUND(SrcInitOutputData%PWaveVel0,1) - i2_l = LBOUND(SrcInitOutputData%PWaveVel0,2) - i2_u = UBOUND(SrcInitOutputData%PWaveVel0,2) - i3_l = LBOUND(SrcInitOutputData%PWaveVel0,3) - i3_u = UBOUND(SrcInitOutputData%PWaveVel0,3) - i4_l = LBOUND(SrcInitOutputData%PWaveVel0,4) - i4_u = UBOUND(SrcInitOutputData%PWaveVel0,4) - IF (.NOT. ASSOCIATED(DstInitOutputData%PWaveVel0)) THEN - ALLOCATE(DstInitOutputData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%PWaveVel0 = SrcInitOutputData%PWaveVel0 -ENDIF -IF (ASSOCIATED(SrcInitOutputData%WaveElev)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElev,1) - i1_u = UBOUND(SrcInitOutputData%WaveElev,1) - i2_l = LBOUND(SrcInitOutputData%WaveElev,2) - i2_u = UBOUND(SrcInitOutputData%WaveElev,2) - i3_l = LBOUND(SrcInitOutputData%WaveElev,3) - i3_u = UBOUND(SrcInitOutputData%WaveElev,3) - IF (.NOT. ASSOCIATED(DstInitOutputData%WaveElev)) THEN - ALLOCATE(DstInitOutputData%WaveElev(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElev = SrcInitOutputData%WaveElev -ENDIF + DstInitOutputData%WaveDynP => SrcInitOutputData%WaveDynP + DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc + DstInitOutputData%WaveAccMCF => SrcInitOutputData%WaveAccMCF + DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel + DstInitOutputData%PWaveDynP0 => SrcInitOutputData%PWaveDynP0 + DstInitOutputData%PWaveAcc0 => SrcInitOutputData%PWaveAcc0 + DstInitOutputData%PWaveAccMCF0 => SrcInitOutputData%PWaveAccMCF0 + DstInitOutputData%PWaveVel0 => SrcInitOutputData%PWaveVel0 + DstInitOutputData%WaveElev => SrcInitOutputData%WaveElev IF (ALLOCATED(SrcInitOutputData%WaveElev0)) THEN i1_l = LBOUND(SrcInitOutputData%WaveElev0,1) i1_u = UBOUND(SrcInitOutputData%WaveElev0,1) @@ -1120,32 +925,19 @@ SUBROUTINE Waves_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, END IF DstInitOutputData%WaveElev0 = SrcInitOutputData%WaveElev0 ENDIF -IF (ASSOCIATED(SrcInitOutputData%WaveTime)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveTime,1) - i1_u = UBOUND(SrcInitOutputData%WaveTime,1) - IF (.NOT. ASSOCIATED(DstInitOutputData%WaveTime)) THEN - ALLOCATE(DstInitOutputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveTime = SrcInitOutputData%WaveTime -ENDIF + DstInitOutputData%WaveTime => SrcInitOutputData%WaveTime DstInitOutputData%WaveTMax = SrcInitOutputData%WaveTMax DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 END SUBROUTINE Waves_CopyInitOutput - SUBROUTINE Waves_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE Waves_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyInitOutput' @@ -1153,78 +945,24 @@ SUBROUTINE Waves_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ASSOCIATED(InitOutputData%WaveElevC0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%WaveElevC0) - InitOutputData%WaveElevC0 => NULL() -ENDIF +NULLIFY(InitOutputData%WaveElevC0) IF (ALLOCATED(InitOutputData%WaveElevC)) THEN DEALLOCATE(InitOutputData%WaveElevC) ENDIF -IF (ASSOCIATED(InitOutputData%WaveDirArr)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%WaveDirArr) - InitOutputData%WaveDirArr => NULL() -ENDIF -IF (ASSOCIATED(InitOutputData%WaveDynP)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%WaveDynP) - InitOutputData%WaveDynP => NULL() -ENDIF -IF (ASSOCIATED(InitOutputData%WaveAcc)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%WaveAcc) - InitOutputData%WaveAcc => NULL() -ENDIF -IF (ASSOCIATED(InitOutputData%WaveAccMCF)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%WaveAccMCF) - InitOutputData%WaveAccMCF => NULL() -ENDIF -IF (ASSOCIATED(InitOutputData%WaveVel)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%WaveVel) - InitOutputData%WaveVel => NULL() -ENDIF -IF (ASSOCIATED(InitOutputData%PWaveDynP0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%PWaveDynP0) - InitOutputData%PWaveDynP0 => NULL() -ENDIF -IF (ASSOCIATED(InitOutputData%PWaveAcc0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%PWaveAcc0) - InitOutputData%PWaveAcc0 => NULL() -ENDIF -IF (ASSOCIATED(InitOutputData%PWaveAccMCF0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%PWaveAccMCF0) - InitOutputData%PWaveAccMCF0 => NULL() -ENDIF -IF (ASSOCIATED(InitOutputData%PWaveVel0)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%PWaveVel0) - InitOutputData%PWaveVel0 => NULL() -ENDIF -IF (ASSOCIATED(InitOutputData%WaveElev)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%WaveElev) - InitOutputData%WaveElev => NULL() -ENDIF +NULLIFY(InitOutputData%WaveDirArr) +NULLIFY(InitOutputData%WaveDynP) +NULLIFY(InitOutputData%WaveAcc) +NULLIFY(InitOutputData%WaveAccMCF) +NULLIFY(InitOutputData%WaveVel) +NULLIFY(InitOutputData%PWaveDynP0) +NULLIFY(InitOutputData%PWaveAcc0) +NULLIFY(InitOutputData%PWaveAccMCF0) +NULLIFY(InitOutputData%PWaveVel0) +NULLIFY(InitOutputData%WaveElev) IF (ALLOCATED(InitOutputData%WaveElev0)) THEN DEALLOCATE(InitOutputData%WaveElev0) ENDIF -IF (ASSOCIATED(InitOutputData%WaveTime)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InitOutputData%WaveTime) - InitOutputData%WaveTime => NULL() -ENDIF +NULLIFY(InitOutputData%WaveTime) END SUBROUTINE Waves_DestroyInitOutput SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1262,79 +1000,19 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WaveElevC0 allocated yes/no - IF ( ASSOCIATED(InData%WaveElevC0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevC0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC0) ! WaveElevC0 - END IF Int_BufSz = Int_BufSz + 1 ! WaveElevC allocated yes/no IF ( ALLOCATED(InData%WaveElevC) ) THEN Int_BufSz = Int_BufSz + 2*3 ! WaveElevC upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC) ! WaveElevC - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDirArr allocated yes/no - IF ( ASSOCIATED(InData%WaveDirArr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveDirArr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDirArr) ! WaveDirArr END IF Re_BufSz = Re_BufSz + 1 ! WaveDirMin Re_BufSz = Re_BufSz + 1 ! WaveDirMax Int_BufSz = Int_BufSz + 1 ! WaveNDir Re_BufSz = Re_BufSz + 1 ! WaveDOmega - Int_BufSz = Int_BufSz + 1 ! WaveDynP allocated yes/no - IF ( ASSOCIATED(InData%WaveDynP) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! WaveDynP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP) ! WaveDynP - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc allocated yes/no - IF ( ASSOCIATED(InData%WaveAcc) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveAcc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc) ! WaveAcc - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAccMCF allocated yes/no - IF ( ASSOCIATED(InData%WaveAccMCF) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveAccMCF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAccMCF) ! WaveAccMCF - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel allocated yes/no - IF ( ASSOCIATED(InData%WaveVel) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel) ! WaveVel - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveDynP0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveDynP0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PWaveDynP0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveDynP0) ! PWaveDynP0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveAcc0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveAcc0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveAcc0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveAcc0) ! PWaveAcc0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveAccMCF0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveAccMCF0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveAccMCF0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveAccMCF0) ! PWaveAccMCF0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveVel0 allocated yes/no - IF ( ASSOCIATED(InData%PWaveVel0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveVel0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveVel0) ! PWaveVel0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev allocated yes/no - IF ( ASSOCIATED(InData%WaveElev) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev) ! WaveElev - END IF Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no IF ( ALLOCATED(InData%WaveElev0) ) THEN Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ASSOCIATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime END IF Db_BufSz = Db_BufSz + 1 ! WaveTMax Re_BufSz = Re_BufSz + 1 ! RhoXg @@ -1367,26 +1045,6 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - IF ( .NOT. ASSOCIATED(InData%WaveElevC0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) - DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF IF ( .NOT. ALLOCATED(InData%WaveElevC) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1411,21 +1069,6 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END DO END DO END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveDirArr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDirArr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) - ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) - Re_Xferred = Re_Xferred + 1 - END DO END IF ReKiBuf(Re_Xferred) = InData%WaveDirMin Re_Xferred = Re_Xferred + 1 @@ -1435,281 +1078,6 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_Xferred = Int_Xferred + 1 ReKiBuf(Re_Xferred) = InData%WaveDOmega Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ASSOCIATED(InData%WaveDynP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%WaveDynP,4), UBOUND(InData%WaveDynP,4) - DO i3 = LBOUND(InData%WaveDynP,3), UBOUND(InData%WaveDynP,3) - DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) - DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveAcc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveAcc,5), UBOUND(InData%WaveAcc,5) - DO i4 = LBOUND(InData%WaveAcc,4), UBOUND(InData%WaveAcc,4) - DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) - DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) - DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveAccMCF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveAccMCF,5), UBOUND(InData%WaveAccMCF,5) - DO i4 = LBOUND(InData%WaveAccMCF,4), UBOUND(InData%WaveAccMCF,4) - DO i3 = LBOUND(InData%WaveAccMCF,3), UBOUND(InData%WaveAccMCF,3) - DO i2 = LBOUND(InData%WaveAccMCF,2), UBOUND(InData%WaveAccMCF,2) - DO i1 = LBOUND(InData%WaveAccMCF,1), UBOUND(InData%WaveAccMCF,1) - ReKiBuf(Re_Xferred) = InData%WaveAccMCF(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveVel,5), UBOUND(InData%WaveVel,5) - DO i4 = LBOUND(InData%WaveVel,4), UBOUND(InData%WaveVel,4) - DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) - DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) - DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) - ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveDynP0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PWaveDynP0,3), UBOUND(InData%PWaveDynP0,3) - DO i2 = LBOUND(InData%PWaveDynP0,2), UBOUND(InData%PWaveDynP0,2) - DO i1 = LBOUND(InData%PWaveDynP0,1), UBOUND(InData%PWaveDynP0,1) - ReKiBuf(Re_Xferred) = InData%PWaveDynP0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveAcc0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveAcc0,4), UBOUND(InData%PWaveAcc0,4) - DO i3 = LBOUND(InData%PWaveAcc0,3), UBOUND(InData%PWaveAcc0,3) - DO i2 = LBOUND(InData%PWaveAcc0,2), UBOUND(InData%PWaveAcc0,2) - DO i1 = LBOUND(InData%PWaveAcc0,1), UBOUND(InData%PWaveAcc0,1) - ReKiBuf(Re_Xferred) = InData%PWaveAcc0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveAccMCF0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveAccMCF0,4), UBOUND(InData%PWaveAccMCF0,4) - DO i3 = LBOUND(InData%PWaveAccMCF0,3), UBOUND(InData%PWaveAccMCF0,3) - DO i2 = LBOUND(InData%PWaveAccMCF0,2), UBOUND(InData%PWaveAccMCF0,2) - DO i1 = LBOUND(InData%PWaveAccMCF0,1), UBOUND(InData%PWaveAccMCF0,1) - ReKiBuf(Re_Xferred) = InData%PWaveAccMCF0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%PWaveVel0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveVel0,4), UBOUND(InData%PWaveVel0,4) - DO i3 = LBOUND(InData%PWaveVel0,3), UBOUND(InData%PWaveVel0,3) - DO i2 = LBOUND(InData%PWaveVel0,2), UBOUND(InData%PWaveVel0,2) - DO i1 = LBOUND(InData%PWaveVel0,1), UBOUND(InData%PWaveVel0,1) - ReKiBuf(Re_Xferred) = InData%PWaveVel0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveElev) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElev,3), UBOUND(InData%WaveElev,3) - DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) - DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) - ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1724,21 +1092,6 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) Re_Xferred = Re_Xferred + 1 END DO - END IF - IF ( .NOT. ASSOCIATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO END IF DbKiBuf(Db_Xferred) = InData%WaveTMax Db_Xferred = Db_Xferred + 1 @@ -1781,29 +1134,7 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElevC0)) DEALLOCATE(OutData%WaveElevC0) - ALLOCATE(OutData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) - DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) - OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF + NULLIFY(OutData%WaveElevC0) IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1832,24 +1163,7 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveDirArr)) DEALLOCATE(OutData%WaveDirArr) - ALLOCATE(OutData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) - OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF + NULLIFY(OutData%WaveDirArr) OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) Re_Xferred = Re_Xferred + 1 OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) @@ -1858,308 +1172,15 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Xferred = Int_Xferred + 1 OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveDynP)) DEALLOCATE(OutData%WaveDynP) - ALLOCATE(OutData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%WaveDynP,4), UBOUND(OutData%WaveDynP,4) - DO i3 = LBOUND(OutData%WaveDynP,3), UBOUND(OutData%WaveDynP,3) - DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) - DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) - OutData%WaveDynP(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveAcc)) DEALLOCATE(OutData%WaveAcc) - ALLOCATE(OutData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAcc,5), UBOUND(OutData%WaveAcc,5) - DO i4 = LBOUND(OutData%WaveAcc,4), UBOUND(OutData%WaveAcc,4) - DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) - DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) - DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) - OutData%WaveAcc(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAccMCF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveAccMCF)) DEALLOCATE(OutData%WaveAccMCF) - ALLOCATE(OutData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAccMCF,5), UBOUND(OutData%WaveAccMCF,5) - DO i4 = LBOUND(OutData%WaveAccMCF,4), UBOUND(OutData%WaveAccMCF,4) - DO i3 = LBOUND(OutData%WaveAccMCF,3), UBOUND(OutData%WaveAccMCF,3) - DO i2 = LBOUND(OutData%WaveAccMCF,2), UBOUND(OutData%WaveAccMCF,2) - DO i1 = LBOUND(OutData%WaveAccMCF,1), UBOUND(OutData%WaveAccMCF,1) - OutData%WaveAccMCF(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveVel)) DEALLOCATE(OutData%WaveVel) - ALLOCATE(OutData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveVel,5), UBOUND(OutData%WaveVel,5) - DO i4 = LBOUND(OutData%WaveVel,4), UBOUND(OutData%WaveVel,4) - DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) - DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) - DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) - OutData%WaveVel(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveDynP0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveDynP0)) DEALLOCATE(OutData%PWaveDynP0) - ALLOCATE(OutData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PWaveDynP0,3), UBOUND(OutData%PWaveDynP0,3) - DO i2 = LBOUND(OutData%PWaveDynP0,2), UBOUND(OutData%PWaveDynP0,2) - DO i1 = LBOUND(OutData%PWaveDynP0,1), UBOUND(OutData%PWaveDynP0,1) - OutData%PWaveDynP0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAcc0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveAcc0)) DEALLOCATE(OutData%PWaveAcc0) - ALLOCATE(OutData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveAcc0,4), UBOUND(OutData%PWaveAcc0,4) - DO i3 = LBOUND(OutData%PWaveAcc0,3), UBOUND(OutData%PWaveAcc0,3) - DO i2 = LBOUND(OutData%PWaveAcc0,2), UBOUND(OutData%PWaveAcc0,2) - DO i1 = LBOUND(OutData%PWaveAcc0,1), UBOUND(OutData%PWaveAcc0,1) - OutData%PWaveAcc0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAccMCF0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveAccMCF0)) DEALLOCATE(OutData%PWaveAccMCF0) - ALLOCATE(OutData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveAccMCF0,4), UBOUND(OutData%PWaveAccMCF0,4) - DO i3 = LBOUND(OutData%PWaveAccMCF0,3), UBOUND(OutData%PWaveAccMCF0,3) - DO i2 = LBOUND(OutData%PWaveAccMCF0,2), UBOUND(OutData%PWaveAccMCF0,2) - DO i1 = LBOUND(OutData%PWaveAccMCF0,1), UBOUND(OutData%PWaveAccMCF0,1) - OutData%PWaveAccMCF0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveVel0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%PWaveVel0)) DEALLOCATE(OutData%PWaveVel0) - ALLOCATE(OutData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveVel0,4), UBOUND(OutData%PWaveVel0,4) - DO i3 = LBOUND(OutData%PWaveVel0,3), UBOUND(OutData%PWaveVel0,3) - DO i2 = LBOUND(OutData%PWaveVel0,2), UBOUND(OutData%PWaveVel0,2) - DO i1 = LBOUND(OutData%PWaveVel0,1), UBOUND(OutData%PWaveVel0,1) - OutData%PWaveVel0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveElev)) DEALLOCATE(OutData%WaveElev) - ALLOCATE(OutData%WaveElev(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElev,3), UBOUND(OutData%WaveElev,3) - DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) - DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) - OutData%WaveElev(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF + NULLIFY(OutData%WaveDynP) + NULLIFY(OutData%WaveAcc) + NULLIFY(OutData%WaveAccMCF) + NULLIFY(OutData%WaveVel) + NULLIFY(OutData%PWaveDynP0) + NULLIFY(OutData%PWaveAcc0) + NULLIFY(OutData%PWaveAccMCF0) + NULLIFY(OutData%PWaveVel0) + NULLIFY(OutData%WaveElev) IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2178,24 +1199,7 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF + NULLIFY(OutData%WaveTime) OutData%WaveTMax = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 OutData%RhoXg = REAL(ReKiBuf(Re_Xferred), SiKi) diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 71219287fe..8c398b1638 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -789,14 +789,12 @@ SUBROUTINE SrvD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%URefLid = SrcInitInputData%URefLid END SUBROUTINE SrvD_CopyInitInput - SUBROUTINE SrvD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SrvD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(SrvD_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInitInput' @@ -804,12 +802,6 @@ SUBROUTINE SrvD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%BlPitchInit)) THEN DEALLOCATE(InitInputData%BlPitchInit) ENDIF @@ -825,7 +817,7 @@ SUBROUTINE SrvD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoin IF (ALLOCATED(InitInputData%BladeRootRefOrient)) THEN DEALLOCATE(InitInputData%BladeRootRefOrient) ENDIF - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitInputData%CableControlRequestor)) THEN DEALLOCATE(InitInputData%CableControlRequestor) @@ -939,7 +931,7 @@ SUBROUTINE SrvD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_BufSz = Int_BufSz + 1 ! UseInputFile ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! PassedPrimaryInputData: size of buffers for each call to pack subtype - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedPrimaryInputData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedPrimaryInputData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1225,7 +1217,7 @@ SUBROUTINE SrvD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM END IF IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, OnlySize ) ! PassedPrimaryInputData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, OnlySize ) ! PassedPrimaryInputData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1692,7 +1684,7 @@ SUBROUTINE SrvD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackfileinfotype( Re_Buf, Db_Buf, Int_Buf, OutData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) ! PassedPrimaryInputData + CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) ! PassedPrimaryInputData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1985,14 +1977,12 @@ SUBROUTINE SrvD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ENDIF END SUBROUTINE SrvD_CopyInitOutput - SUBROUTINE SrvD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SrvD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(SrvD_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInitOutput' @@ -2000,19 +1990,13 @@ SUBROUTINE SrvD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) ENDIF IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN DEALLOCATE(InitOutputData%WriteOutputUnt) ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitOutputData%LinNames_y)) THEN DEALLOCATE(InitOutputData%LinNames_y) @@ -2087,7 +2071,7 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2206,7 +2190,7 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err END DO ! I END DO END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2466,7 +2450,7 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2810,14 +2794,12 @@ SUBROUTINE SrvD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%EXavrSWAP = SrcInputFileData%EXavrSWAP END SUBROUTINE SrvD_CopyInputFile - SUBROUTINE SrvD_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SrvD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInputFile' @@ -2825,12 +2807,6 @@ SUBROUTINE SrvD_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputFileData%OutList)) THEN DEALLOCATE(InputFileData%OutList) ENDIF @@ -4079,14 +4055,12 @@ SUBROUTINE SrvD_CopyBladedDLLType( SrcBladedDLLTypeData, DstBladedDLLTypeData, C ENDIF END SUBROUTINE SrvD_CopyBladedDLLType - SUBROUTINE SrvD_DestroyBladedDLLType( BladedDLLTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SrvD_DestroyBladedDLLType( BladedDLLTypeData, ErrStat, ErrMsg ) TYPE(BladedDLLType), INTENT(INOUT) :: BladedDLLTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyBladedDLLType' @@ -4094,12 +4068,6 @@ SUBROUTINE SrvD_DestroyBladedDLLType( BladedDLLTypeData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(BladedDLLTypeData%avrSWAP)) THEN DEALLOCATE(BladedDLLTypeData%avrSWAP) ENDIF @@ -4108,7 +4076,7 @@ SUBROUTINE SrvD_DestroyBladedDLLType( BladedDLLTypeData, ErrStat, ErrMsg, DEALLO ENDIF IF (ALLOCATED(BladedDLLTypeData%LogChannels_OutParam)) THEN DO i1 = LBOUND(BladedDLLTypeData%LogChannels_OutParam,1), UBOUND(BladedDLLTypeData%LogChannels_OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( BladedDLLTypeData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyOutParmType( BladedDLLTypeData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(BladedDLLTypeData%LogChannels_OutParam) @@ -4244,7 +4212,7 @@ SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%LogChannels_OutParam,1), UBOUND(InData%LogChannels_OutParam,1) Int_BufSz = Int_BufSz + 3 ! LogChannels_OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LogChannels_OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LogChannels_OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4530,7 +4498,7 @@ SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%LogChannels_OutParam,1), UBOUND(InData%LogChannels_OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! LogChannels_OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! LogChannels_OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5219,7 +5187,7 @@ SUBROUTINE SrvD_UnPackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2 ) ! LogChannels_OutParam + CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2 ) ! LogChannels_OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5888,14 +5856,12 @@ SUBROUTINE SrvD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Err ENDIF END SUBROUTINE SrvD_CopyContState - SUBROUTINE SrvD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SrvD_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(SrvD_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyContState' @@ -5903,36 +5869,30 @@ SUBROUTINE SrvD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ContStateData%BStC)) THEN DO i1 = LBOUND(ContStateData%BStC,1), UBOUND(ContStateData%BStC,1) - CALL StC_DestroyContState( ContStateData%BStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyContState( ContStateData%BStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ContStateData%BStC) ENDIF IF (ALLOCATED(ContStateData%NStC)) THEN DO i1 = LBOUND(ContStateData%NStC,1), UBOUND(ContStateData%NStC,1) - CALL StC_DestroyContState( ContStateData%NStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyContState( ContStateData%NStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ContStateData%NStC) ENDIF IF (ALLOCATED(ContStateData%TStC)) THEN DO i1 = LBOUND(ContStateData%TStC,1), UBOUND(ContStateData%TStC,1) - CALL StC_DestroyContState( ContStateData%TStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyContState( ContStateData%TStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ContStateData%TStC) ENDIF IF (ALLOCATED(ContStateData%SStC)) THEN DO i1 = LBOUND(ContStateData%SStC,1), UBOUND(ContStateData%SStC,1) - CALL StC_DestroyContState( ContStateData%SStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyContState( ContStateData%SStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ContStateData%SStC) @@ -6600,14 +6560,12 @@ SUBROUTINE SrvD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Err ENDIF END SUBROUTINE SrvD_CopyDiscState - SUBROUTINE SrvD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SrvD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(SrvD_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyDiscState' @@ -6615,36 +6573,30 @@ SUBROUTINE SrvD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(DiscStateData%BStC)) THEN DO i1 = LBOUND(DiscStateData%BStC,1), UBOUND(DiscStateData%BStC,1) - CALL StC_DestroyDiscState( DiscStateData%BStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyDiscState( DiscStateData%BStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(DiscStateData%BStC) ENDIF IF (ALLOCATED(DiscStateData%NStC)) THEN DO i1 = LBOUND(DiscStateData%NStC,1), UBOUND(DiscStateData%NStC,1) - CALL StC_DestroyDiscState( DiscStateData%NStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyDiscState( DiscStateData%NStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(DiscStateData%NStC) ENDIF IF (ALLOCATED(DiscStateData%TStC)) THEN DO i1 = LBOUND(DiscStateData%TStC,1), UBOUND(DiscStateData%TStC,1) - CALL StC_DestroyDiscState( DiscStateData%TStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyDiscState( DiscStateData%TStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(DiscStateData%TStC) ENDIF IF (ALLOCATED(DiscStateData%SStC)) THEN DO i1 = LBOUND(DiscStateData%SStC,1), UBOUND(DiscStateData%SStC,1) - CALL StC_DestroyDiscState( DiscStateData%SStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyDiscState( DiscStateData%SStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(DiscStateData%SStC) @@ -7312,14 +7264,12 @@ SUBROUTINE SrvD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCod ENDIF END SUBROUTINE SrvD_CopyConstrState - SUBROUTINE SrvD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SrvD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(SrvD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyConstrState' @@ -7327,36 +7277,30 @@ SUBROUTINE SrvD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ConstrStateData%BStC)) THEN DO i1 = LBOUND(ConstrStateData%BStC,1), UBOUND(ConstrStateData%BStC,1) - CALL StC_DestroyConstrState( ConstrStateData%BStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyConstrState( ConstrStateData%BStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ConstrStateData%BStC) ENDIF IF (ALLOCATED(ConstrStateData%NStC)) THEN DO i1 = LBOUND(ConstrStateData%NStC,1), UBOUND(ConstrStateData%NStC,1) - CALL StC_DestroyConstrState( ConstrStateData%NStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyConstrState( ConstrStateData%NStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ConstrStateData%NStC) ENDIF IF (ALLOCATED(ConstrStateData%TStC)) THEN DO i1 = LBOUND(ConstrStateData%TStC,1), UBOUND(ConstrStateData%TStC,1) - CALL StC_DestroyConstrState( ConstrStateData%TStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyConstrState( ConstrStateData%TStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ConstrStateData%TStC) ENDIF IF (ALLOCATED(ConstrStateData%SStC)) THEN DO i1 = LBOUND(ConstrStateData%SStC,1), UBOUND(ConstrStateData%SStC,1) - CALL StC_DestroyConstrState( ConstrStateData%SStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyConstrState( ConstrStateData%SStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ConstrStateData%SStC) @@ -8101,14 +8045,12 @@ SUBROUTINE SrvD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ENDIF END SUBROUTINE SrvD_CopyOtherState - SUBROUTINE SrvD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SrvD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(SrvD_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyOtherState' @@ -8116,12 +8058,6 @@ SUBROUTINE SrvD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OtherStateData%BegPitMan)) THEN DEALLOCATE(OtherStateData%BegPitMan) ENDIF @@ -8142,28 +8078,28 @@ SUBROUTINE SrvD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpo ENDIF IF (ALLOCATED(OtherStateData%BStC)) THEN DO i1 = LBOUND(OtherStateData%BStC,1), UBOUND(OtherStateData%BStC,1) - CALL StC_DestroyOtherState( OtherStateData%BStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyOtherState( OtherStateData%BStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OtherStateData%BStC) ENDIF IF (ALLOCATED(OtherStateData%NStC)) THEN DO i1 = LBOUND(OtherStateData%NStC,1), UBOUND(OtherStateData%NStC,1) - CALL StC_DestroyOtherState( OtherStateData%NStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyOtherState( OtherStateData%NStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OtherStateData%NStC) ENDIF IF (ALLOCATED(OtherStateData%TStC)) THEN DO i1 = LBOUND(OtherStateData%TStC,1), UBOUND(OtherStateData%TStC,1) - CALL StC_DestroyOtherState( OtherStateData%TStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyOtherState( OtherStateData%TStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OtherStateData%TStC) ENDIF IF (ALLOCATED(OtherStateData%SStC)) THEN DO i1 = LBOUND(OtherStateData%SStC,1), UBOUND(OtherStateData%SStC,1) - CALL StC_DestroyOtherState( OtherStateData%SStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyOtherState( OtherStateData%SStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OtherStateData%SStC) @@ -9156,14 +9092,12 @@ SUBROUTINE SrvD_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, C ENDIF END SUBROUTINE SrvD_CopyModuleMapType - SUBROUTINE SrvD_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SrvD_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) TYPE(SrvD_ModuleMapType), INTENT(INOUT) :: ModuleMapTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyModuleMapType' @@ -9171,16 +9105,10 @@ SUBROUTINE SrvD_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg, DEALLO ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ModuleMapTypeData%u_BStC_Mot2_BStC)) THEN DO i2 = LBOUND(ModuleMapTypeData%u_BStC_Mot2_BStC,2), UBOUND(ModuleMapTypeData%u_BStC_Mot2_BStC,2) DO i1 = LBOUND(ModuleMapTypeData%u_BStC_Mot2_BStC,1), UBOUND(ModuleMapTypeData%u_BStC_Mot2_BStC,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -9188,21 +9116,21 @@ SUBROUTINE SrvD_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg, DEALLO ENDIF IF (ALLOCATED(ModuleMapTypeData%u_NStC_Mot2_NStC)) THEN DO i1 = LBOUND(ModuleMapTypeData%u_NStC_Mot2_NStC,1), UBOUND(ModuleMapTypeData%u_NStC_Mot2_NStC,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%u_NStC_Mot2_NStC) ENDIF IF (ALLOCATED(ModuleMapTypeData%u_TStC_Mot2_TStC)) THEN DO i1 = LBOUND(ModuleMapTypeData%u_TStC_Mot2_TStC,1), UBOUND(ModuleMapTypeData%u_TStC_Mot2_TStC,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%u_TStC_Mot2_TStC) ENDIF IF (ALLOCATED(ModuleMapTypeData%u_SStC_Mot2_SStC)) THEN DO i1 = LBOUND(ModuleMapTypeData%u_SStC_Mot2_SStC,1), UBOUND(ModuleMapTypeData%u_SStC_Mot2_SStC,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%u_SStC_Mot2_SStC) @@ -9210,7 +9138,7 @@ SUBROUTINE SrvD_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg, DEALLO IF (ALLOCATED(ModuleMapTypeData%BStC_Frc2_y_BStC)) THEN DO i2 = LBOUND(ModuleMapTypeData%BStC_Frc2_y_BStC,2), UBOUND(ModuleMapTypeData%BStC_Frc2_y_BStC,2) DO i1 = LBOUND(ModuleMapTypeData%BStC_Frc2_y_BStC,1), UBOUND(ModuleMapTypeData%BStC_Frc2_y_BStC,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -9218,21 +9146,21 @@ SUBROUTINE SrvD_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg, DEALLO ENDIF IF (ALLOCATED(ModuleMapTypeData%NStC_Frc2_y_NStC)) THEN DO i1 = LBOUND(ModuleMapTypeData%NStC_Frc2_y_NStC,1), UBOUND(ModuleMapTypeData%NStC_Frc2_y_NStC,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%NStC_Frc2_y_NStC) ENDIF IF (ALLOCATED(ModuleMapTypeData%TStC_Frc2_y_TStC)) THEN DO i1 = LBOUND(ModuleMapTypeData%TStC_Frc2_y_TStC,1), UBOUND(ModuleMapTypeData%TStC_Frc2_y_TStC,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%TStC_Frc2_y_TStC) ENDIF IF (ALLOCATED(ModuleMapTypeData%SStC_Frc2_y_SStC)) THEN DO i1 = LBOUND(ModuleMapTypeData%SStC_Frc2_y_SStC,1), UBOUND(ModuleMapTypeData%SStC_Frc2_y_SStC,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ModuleMapTypeData%SStC_Frc2_y_SStC) @@ -9281,7 +9209,7 @@ SUBROUTINE SrvD_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DO i2 = LBOUND(InData%u_BStC_Mot2_BStC,2), UBOUND(InData%u_BStC_Mot2_BStC,2) DO i1 = LBOUND(InData%u_BStC_Mot2_BStC,1), UBOUND(InData%u_BStC_Mot2_BStC,1) Int_BufSz = Int_BufSz + 3 ! u_BStC_Mot2_BStC: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_BStC_Mot2_BStC + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_BStC_Mot2_BStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9305,7 +9233,7 @@ SUBROUTINE SrvD_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! u_NStC_Mot2_NStC upper/lower bounds for each dimension DO i1 = LBOUND(InData%u_NStC_Mot2_NStC,1), UBOUND(InData%u_NStC_Mot2_NStC,1) Int_BufSz = Int_BufSz + 3 ! u_NStC_Mot2_NStC: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_NStC_Mot2_NStC + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_NStC_Mot2_NStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9328,7 +9256,7 @@ SUBROUTINE SrvD_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! u_TStC_Mot2_TStC upper/lower bounds for each dimension DO i1 = LBOUND(InData%u_TStC_Mot2_TStC,1), UBOUND(InData%u_TStC_Mot2_TStC,1) Int_BufSz = Int_BufSz + 3 ! u_TStC_Mot2_TStC: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_TStC_Mot2_TStC + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_TStC_Mot2_TStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9351,7 +9279,7 @@ SUBROUTINE SrvD_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! u_SStC_Mot2_SStC upper/lower bounds for each dimension DO i1 = LBOUND(InData%u_SStC_Mot2_SStC,1), UBOUND(InData%u_SStC_Mot2_SStC,1) Int_BufSz = Int_BufSz + 3 ! u_SStC_Mot2_SStC: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_SStC_Mot2_SStC + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_SStC_Mot2_SStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9375,7 +9303,7 @@ SUBROUTINE SrvD_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DO i2 = LBOUND(InData%BStC_Frc2_y_BStC,2), UBOUND(InData%BStC_Frc2_y_BStC,2) DO i1 = LBOUND(InData%BStC_Frc2_y_BStC,1), UBOUND(InData%BStC_Frc2_y_BStC,1) Int_BufSz = Int_BufSz + 3 ! BStC_Frc2_y_BStC: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! BStC_Frc2_y_BStC + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! BStC_Frc2_y_BStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9399,7 +9327,7 @@ SUBROUTINE SrvD_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! NStC_Frc2_y_NStC upper/lower bounds for each dimension DO i1 = LBOUND(InData%NStC_Frc2_y_NStC,1), UBOUND(InData%NStC_Frc2_y_NStC,1) Int_BufSz = Int_BufSz + 3 ! NStC_Frc2_y_NStC: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC_Frc2_y_NStC + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC_Frc2_y_NStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9422,7 +9350,7 @@ SUBROUTINE SrvD_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! TStC_Frc2_y_TStC upper/lower bounds for each dimension DO i1 = LBOUND(InData%TStC_Frc2_y_TStC,1), UBOUND(InData%TStC_Frc2_y_TStC,1) Int_BufSz = Int_BufSz + 3 ! TStC_Frc2_y_TStC: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC_Frc2_y_TStC + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC_Frc2_y_TStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9445,7 +9373,7 @@ SUBROUTINE SrvD_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! SStC_Frc2_y_SStC upper/lower bounds for each dimension DO i1 = LBOUND(InData%SStC_Frc2_y_SStC,1), UBOUND(InData%SStC_Frc2_y_SStC,1) Int_BufSz = Int_BufSz + 3 ! SStC_Frc2_y_SStC: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC_Frc2_y_SStC + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC_Frc2_y_SStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9505,7 +9433,7 @@ SUBROUTINE SrvD_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DO i2 = LBOUND(InData%u_BStC_Mot2_BStC,2), UBOUND(InData%u_BStC_Mot2_BStC,2) DO i1 = LBOUND(InData%u_BStC_Mot2_BStC,1), UBOUND(InData%u_BStC_Mot2_BStC,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_BStC_Mot2_BStC + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_BStC_Mot2_BStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9547,7 +9475,7 @@ SUBROUTINE SrvD_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%u_NStC_Mot2_NStC,1), UBOUND(InData%u_NStC_Mot2_NStC,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_NStC_Mot2_NStC + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_NStC_Mot2_NStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9588,7 +9516,7 @@ SUBROUTINE SrvD_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%u_TStC_Mot2_TStC,1), UBOUND(InData%u_TStC_Mot2_TStC,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_TStC_Mot2_TStC + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_TStC_Mot2_TStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9629,7 +9557,7 @@ SUBROUTINE SrvD_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%u_SStC_Mot2_SStC,1), UBOUND(InData%u_SStC_Mot2_SStC,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_SStC_Mot2_SStC + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_SStC_Mot2_SStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9674,7 +9602,7 @@ SUBROUTINE SrvD_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DO i2 = LBOUND(InData%BStC_Frc2_y_BStC,2), UBOUND(InData%BStC_Frc2_y_BStC,2) DO i1 = LBOUND(InData%BStC_Frc2_y_BStC,1), UBOUND(InData%BStC_Frc2_y_BStC,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BStC_Frc2_y_BStC + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BStC_Frc2_y_BStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9716,7 +9644,7 @@ SUBROUTINE SrvD_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%NStC_Frc2_y_NStC,1), UBOUND(InData%NStC_Frc2_y_NStC,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC_Frc2_y_NStC + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC_Frc2_y_NStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9757,7 +9685,7 @@ SUBROUTINE SrvD_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%TStC_Frc2_y_TStC,1), UBOUND(InData%TStC_Frc2_y_TStC,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC_Frc2_y_TStC + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC_Frc2_y_TStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9798,7 +9726,7 @@ SUBROUTINE SrvD_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%SStC_Frc2_y_SStC,1), UBOUND(InData%SStC_Frc2_y_SStC,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC_Frc2_y_SStC + CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC_Frc2_y_SStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9909,7 +9837,7 @@ SUBROUTINE SrvD_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2 ) ! u_BStC_Mot2_BStC + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2 ) ! u_BStC_Mot2_BStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9966,7 +9894,7 @@ SUBROUTINE SrvD_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2 ) ! u_NStC_Mot2_NStC + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2 ) ! u_NStC_Mot2_NStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10022,7 +9950,7 @@ SUBROUTINE SrvD_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2 ) ! u_TStC_Mot2_TStC + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2 ) ! u_TStC_Mot2_TStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10078,7 +10006,7 @@ SUBROUTINE SrvD_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2 ) ! u_SStC_Mot2_SStC + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2 ) ! u_SStC_Mot2_SStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10138,7 +10066,7 @@ SUBROUTINE SrvD_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2 ) ! BStC_Frc2_y_BStC + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2 ) ! BStC_Frc2_y_BStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10195,7 +10123,7 @@ SUBROUTINE SrvD_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2 ) ! NStC_Frc2_y_NStC + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2 ) ! NStC_Frc2_y_NStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10251,7 +10179,7 @@ SUBROUTINE SrvD_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2 ) ! TStC_Frc2_y_TStC + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2 ) ! TStC_Frc2_y_TStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10307,7 +10235,7 @@ SUBROUTINE SrvD_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2 ) ! SStC_Frc2_y_SStC + CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2 ) ! SStC_Frc2_y_SStC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10566,14 +10494,12 @@ SUBROUTINE SrvD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%PrevTstepNcall = SrcMiscData%PrevTstepNcall END SUBROUTINE SrvD_CopyMisc - SUBROUTINE SrvD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SrvD_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(SrvD_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyMisc' @@ -10581,41 +10507,35 @@ SUBROUTINE SrvD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL SrvD_Destroybladeddlltype( MiscData%dll_data, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyBladedDLLType( MiscData%dll_data, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(MiscData%xd_BlPitchFilter)) THEN DEALLOCATE(MiscData%xd_BlPitchFilter) ENDIF IF (ALLOCATED(MiscData%BStC)) THEN DO i1 = LBOUND(MiscData%BStC,1), UBOUND(MiscData%BStC,1) - CALL StC_DestroyMisc( MiscData%BStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyMisc( MiscData%BStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%BStC) ENDIF IF (ALLOCATED(MiscData%NStC)) THEN DO i1 = LBOUND(MiscData%NStC,1), UBOUND(MiscData%NStC,1) - CALL StC_DestroyMisc( MiscData%NStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyMisc( MiscData%NStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%NStC) ENDIF IF (ALLOCATED(MiscData%TStC)) THEN DO i1 = LBOUND(MiscData%TStC,1), UBOUND(MiscData%TStC,1) - CALL StC_DestroyMisc( MiscData%TStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyMisc( MiscData%TStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%TStC) ENDIF IF (ALLOCATED(MiscData%SStC)) THEN DO i1 = LBOUND(MiscData%SStC,1), UBOUND(MiscData%SStC,1) - CALL StC_DestroyMisc( MiscData%SStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyMisc( MiscData%SStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%SStC) @@ -10623,7 +10543,7 @@ SUBROUTINE SrvD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(MiscData%u_BStC)) THEN DO i2 = LBOUND(MiscData%u_BStC,2), UBOUND(MiscData%u_BStC,2) DO i1 = LBOUND(MiscData%u_BStC,1), UBOUND(MiscData%u_BStC,1) - CALL StC_DestroyInput( MiscData%u_BStC(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyInput( MiscData%u_BStC(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -10632,7 +10552,7 @@ SUBROUTINE SrvD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(MiscData%u_NStC)) THEN DO i2 = LBOUND(MiscData%u_NStC,2), UBOUND(MiscData%u_NStC,2) DO i1 = LBOUND(MiscData%u_NStC,1), UBOUND(MiscData%u_NStC,1) - CALL StC_DestroyInput( MiscData%u_NStC(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyInput( MiscData%u_NStC(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -10641,7 +10561,7 @@ SUBROUTINE SrvD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(MiscData%u_TStC)) THEN DO i2 = LBOUND(MiscData%u_TStC,2), UBOUND(MiscData%u_TStC,2) DO i1 = LBOUND(MiscData%u_TStC,1), UBOUND(MiscData%u_TStC,1) - CALL StC_DestroyInput( MiscData%u_TStC(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyInput( MiscData%u_TStC(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -10650,7 +10570,7 @@ SUBROUTINE SrvD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(MiscData%u_SStC)) THEN DO i2 = LBOUND(MiscData%u_SStC,2), UBOUND(MiscData%u_SStC,2) DO i1 = LBOUND(MiscData%u_SStC,1), UBOUND(MiscData%u_SStC,1) - CALL StC_DestroyInput( MiscData%u_SStC(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyInput( MiscData%u_SStC(i1,i2), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO @@ -10658,33 +10578,33 @@ SUBROUTINE SrvD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(MiscData%y_BStC)) THEN DO i1 = LBOUND(MiscData%y_BStC,1), UBOUND(MiscData%y_BStC,1) - CALL StC_DestroyOutput( MiscData%y_BStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyOutput( MiscData%y_BStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%y_BStC) ENDIF IF (ALLOCATED(MiscData%y_NStC)) THEN DO i1 = LBOUND(MiscData%y_NStC,1), UBOUND(MiscData%y_NStC,1) - CALL StC_DestroyOutput( MiscData%y_NStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyOutput( MiscData%y_NStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%y_NStC) ENDIF IF (ALLOCATED(MiscData%y_TStC)) THEN DO i1 = LBOUND(MiscData%y_TStC,1), UBOUND(MiscData%y_TStC,1) - CALL StC_DestroyOutput( MiscData%y_TStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyOutput( MiscData%y_TStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%y_TStC) ENDIF IF (ALLOCATED(MiscData%y_SStC)) THEN DO i1 = LBOUND(MiscData%y_SStC,1), UBOUND(MiscData%y_SStC,1) - CALL StC_DestroyOutput( MiscData%y_SStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyOutput( MiscData%y_SStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%y_SStC) ENDIF - CALL SrvD_Destroymodulemaptype( MiscData%SrvD_MeshMap, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SrvD_DestroyModuleMapType( MiscData%SrvD_MeshMap, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SrvD_DestroyMisc @@ -10726,7 +10646,7 @@ SUBROUTINE SrvD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_BufSz = Db_BufSz + 1 ! LastTimeCalled ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! dll_data: size of buffers for each call to pack subtype - CALL SrvD_Packbladeddlltype( Re_Buf, Db_Buf, Int_Buf, InData%dll_data, ErrStat2, ErrMsg2, .TRUE. ) ! dll_data + CALL SrvD_PackBladedDLLType( Re_Buf, Db_Buf, Int_Buf, InData%dll_data, ErrStat2, ErrMsg2, .TRUE. ) ! dll_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11034,7 +10954,7 @@ SUBROUTINE SrvD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S END DO END IF Int_BufSz = Int_BufSz + 3 ! SrvD_MeshMap: size of buffers for each call to pack subtype - CALL SrvD_Packmodulemaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_MeshMap, ErrStat2, ErrMsg2, .TRUE. ) ! SrvD_MeshMap + CALL SrvD_PackModuleMapType( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_MeshMap, ErrStat2, ErrMsg2, .TRUE. ) ! SrvD_MeshMap CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11080,7 +11000,7 @@ SUBROUTINE SrvD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S DbKiBuf(Db_Xferred) = InData%LastTimeCalled Db_Xferred = Db_Xferred + 1 - CALL SrvD_Packbladeddlltype( Re_Buf, Db_Buf, Int_Buf, InData%dll_data, ErrStat2, ErrMsg2, OnlySize ) ! dll_data + CALL SrvD_PackBladedDLLType( Re_Buf, Db_Buf, Int_Buf, InData%dll_data, ErrStat2, ErrMsg2, OnlySize ) ! dll_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11639,7 +11559,7 @@ SUBROUTINE SrvD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ENDIF END DO END IF - CALL SrvD_Packmodulemaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_MeshMap, ErrStat2, ErrMsg2, OnlySize ) ! SrvD_MeshMap + CALL SrvD_PackModuleMapType( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_MeshMap, ErrStat2, ErrMsg2, OnlySize ) ! SrvD_MeshMap CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11734,7 +11654,7 @@ SUBROUTINE SrvD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_Unpackbladeddlltype( Re_Buf, Db_Buf, Int_Buf, OutData%dll_data, ErrStat2, ErrMsg2 ) ! dll_data + CALL SrvD_UnpackBladedDLLType( Re_Buf, Db_Buf, Int_Buf, OutData%dll_data, ErrStat2, ErrMsg2 ) ! dll_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12488,7 +12408,7 @@ SUBROUTINE SrvD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_Unpackmodulemaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SrvD_MeshMap, ErrStat2, ErrMsg2 ) ! SrvD_MeshMap + CALL SrvD_UnpackModuleMapType( Re_Buf, Db_Buf, Int_Buf, OutData%SrvD_MeshMap, ErrStat2, ErrMsg2 ) ! SrvD_MeshMap CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12992,14 +12912,12 @@ SUBROUTINE SrvD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%URefLid = SrcParamData%URefLid END SUBROUTINE SrvD_CopyParam - SUBROUTINE SrvD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SrvD_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(SrvD_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyParam' @@ -13007,12 +12925,6 @@ SUBROUTINE SrvD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%BlPitchInit)) THEN DEALLOCATE(ParamData%BlPitchInit) ENDIF @@ -13030,7 +12942,7 @@ SUBROUTINE SrvD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) @@ -13039,28 +12951,28 @@ SUBROUTINE SrvD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(ParamData%BStC)) THEN DO i1 = LBOUND(ParamData%BStC,1), UBOUND(ParamData%BStC,1) - CALL StC_DestroyParam( ParamData%BStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyParam( ParamData%BStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%BStC) ENDIF IF (ALLOCATED(ParamData%NStC)) THEN DO i1 = LBOUND(ParamData%NStC,1), UBOUND(ParamData%NStC,1) - CALL StC_DestroyParam( ParamData%NStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyParam( ParamData%NStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%NStC) ENDIF IF (ALLOCATED(ParamData%TStC)) THEN DO i1 = LBOUND(ParamData%TStC,1), UBOUND(ParamData%TStC,1) - CALL StC_DestroyParam( ParamData%TStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyParam( ParamData%TStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%TStC) ENDIF IF (ALLOCATED(ParamData%SStC)) THEN DO i1 = LBOUND(ParamData%SStC,1), UBOUND(ParamData%SStC,1) - CALL StC_DestroyParam( ParamData%SStC(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL StC_DestroyParam( ParamData%SStC(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%SStC) @@ -13253,7 +13165,7 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13744,7 +13656,7 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14668,7 +14580,7 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15655,14 +15567,12 @@ SUBROUTINE SrvD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE SrvD_CopyInput - SUBROUTINE SrvD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SrvD_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(SrvD_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInput' @@ -15670,12 +15580,6 @@ SUBROUTINE SrvD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputData%BlPitch)) THEN DEALLOCATE(InputData%BlPitch) ENDIF @@ -17242,14 +17146,12 @@ SUBROUTINE SrvD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err ENDIF END SUBROUTINE SrvD_CopyOutput - SUBROUTINE SrvD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SrvD_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(SrvD_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyOutput' @@ -17257,12 +17159,6 @@ SUBROUTINE SrvD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%WriteOutput)) THEN DEALLOCATE(OutputData%WriteOutput) ENDIF diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index 3f5dd2582c..5eb8655303 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -259,7 +259,6 @@ SUBROUTINE StC_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrS INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyInputFile' @@ -371,14 +370,12 @@ SUBROUTINE StC_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrS ENDIF END SUBROUTINE StC_CopyInputFile - SUBROUTINE StC_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE StC_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) TYPE(StC_InputFile), INTENT(INOUT) :: InputFileData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInputFile' @@ -386,12 +383,6 @@ SUBROUTINE StC_DestroyInputFile( InputFileData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputFileData%F_TBL)) THEN DEALLOCATE(InputFileData%F_TBL) ENDIF @@ -749,7 +740,6 @@ SUBROUTINE StC_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: i INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackInputFile' @@ -1054,14 +1044,12 @@ SUBROUTINE StC_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrS IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE StC_CopyInitInput - SUBROUTINE StC_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE StC_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(StC_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInitInput' @@ -1069,12 +1057,6 @@ SUBROUTINE StC_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%InitRefPos)) THEN DEALLOCATE(InitInputData%InitRefPos) ENDIF @@ -1087,9 +1069,9 @@ SUBROUTINE StC_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoint IF (ALLOCATED(InitInputData%InitRefOrient)) THEN DEALLOCATE(InitInputData%InitRefOrient) ENDIF - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedPrescribeFrcData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedPrescribeFrcData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE StC_DestroyInitInput @@ -1155,7 +1137,7 @@ SUBROUTINE StC_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 1 ! UseInputFile ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! PassedPrimaryInputData: size of buffers for each call to pack subtype - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedPrimaryInputData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedPrimaryInputData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1173,7 +1155,7 @@ SUBROUTINE StC_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END IF Int_BufSz = Int_BufSz + 1 ! UseInputFile_PrescribeFrc Int_BufSz = Int_BufSz + 3 ! PassedPrescribeFrcData: size of buffers for each call to pack subtype - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrescribeFrcData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedPrescribeFrcData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrescribeFrcData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedPrescribeFrcData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1322,7 +1304,7 @@ SUBROUTINE StC_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END IF IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, OnlySize ) ! PassedPrimaryInputData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, OnlySize ) ! PassedPrimaryInputData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1352,7 +1334,7 @@ SUBROUTINE StC_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ENDIF IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile_PrescribeFrc, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrescribeFrcData, ErrStat2, ErrMsg2, OnlySize ) ! PassedPrescribeFrcData + CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrescribeFrcData, ErrStat2, ErrMsg2, OnlySize ) ! PassedPrescribeFrcData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1564,7 +1546,7 @@ SUBROUTINE StC_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackfileinfotype( Re_Buf, Db_Buf, Int_Buf, OutData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) ! PassedPrimaryInputData + CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) ! PassedPrimaryInputData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1606,7 +1588,7 @@ SUBROUTINE StC_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackfileinfotype( Re_Buf, Db_Buf, Int_Buf, OutData%PassedPrescribeFrcData, ErrStat2, ErrMsg2 ) ! PassedPrescribeFrcData + CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedPrescribeFrcData, ErrStat2, ErrMsg2 ) ! PassedPrescribeFrcData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1729,14 +1711,12 @@ SUBROUTINE StC_CopyCtrlChanInitInfoType( SrcCtrlChanInitInfoTypeData, DstCtrlCha ENDIF END SUBROUTINE StC_CopyCtrlChanInitInfoType - SUBROUTINE StC_DestroyCtrlChanInitInfoType( CtrlChanInitInfoTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE StC_DestroyCtrlChanInitInfoType( CtrlChanInitInfoTypeData, ErrStat, ErrMsg ) TYPE(StC_CtrlChanInitInfoType), INTENT(INOUT) :: CtrlChanInitInfoTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyCtrlChanInitInfoType' @@ -1744,12 +1724,6 @@ SUBROUTINE StC_DestroyCtrlChanInitInfoType( CtrlChanInitInfoTypeData, ErrStat, E ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(CtrlChanInitInfoTypeData%Requestor)) THEN DEALLOCATE(CtrlChanInitInfoTypeData%Requestor) ENDIF @@ -2229,14 +2203,12 @@ SUBROUTINE StC_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, E ENDIF END SUBROUTINE StC_CopyInitOutput - SUBROUTINE StC_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE StC_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(StC_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInitOutput' @@ -2244,12 +2216,6 @@ SUBROUTINE StC_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%RelPosition)) THEN DEALLOCATE(InitOutputData%RelPosition) ENDIF @@ -2429,14 +2395,12 @@ SUBROUTINE StC_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrS ENDIF END SUBROUTINE StC_CopyContState - SUBROUTINE StC_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE StC_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(StC_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyContState' @@ -2444,12 +2408,6 @@ SUBROUTINE StC_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ContStateData%StC_x)) THEN DEALLOCATE(ContStateData%StC_x) ENDIF @@ -2614,14 +2572,12 @@ SUBROUTINE StC_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE StC_CopyDiscState - SUBROUTINE StC_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE StC_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(StC_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyDiscState' @@ -2629,12 +2585,6 @@ SUBROUTINE StC_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpoint ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE StC_DestroyDiscState SUBROUTINE StC_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2751,14 +2701,12 @@ SUBROUTINE StC_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE StC_CopyConstrState - SUBROUTINE StC_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE StC_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(StC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyConstrState' @@ -2766,12 +2714,6 @@ SUBROUTINE StC_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE StC_DestroyConstrState SUBROUTINE StC_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2888,14 +2830,12 @@ SUBROUTINE StC_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState END SUBROUTINE StC_CopyOtherState - SUBROUTINE StC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE StC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(StC_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyOtherState' @@ -2903,12 +2843,6 @@ SUBROUTINE StC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE StC_DestroyOtherState SUBROUTINE StC_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -3265,14 +3199,12 @@ SUBROUTINE StC_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%PrescribedInterpIdx = SrcMiscData%PrescribedInterpIdx END SUBROUTINE StC_CopyMisc - SUBROUTINE StC_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE StC_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(StC_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyMisc' @@ -3280,12 +3212,6 @@ SUBROUTINE StC_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MiscData%F_stop)) THEN DEALLOCATE(MiscData%F_stop) ENDIF @@ -4360,14 +4286,12 @@ SUBROUTINE StC_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE StC_CopyParam - SUBROUTINE StC_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE StC_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(StC_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyParam' @@ -4375,12 +4299,6 @@ SUBROUTINE StC_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%F_TBL)) THEN DEALLOCATE(ParamData%F_TBL) ENDIF @@ -4984,14 +4902,12 @@ SUBROUTINE StC_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ENDIF END SUBROUTINE StC_CopyInput - SUBROUTINE StC_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE StC_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(StC_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInput' @@ -4999,12 +4915,6 @@ SUBROUTINE StC_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputData%Mesh)) THEN DO i1 = LBOUND(InputData%Mesh,1), UBOUND(InputData%Mesh,1) CALL MeshDestroy( InputData%Mesh(i1), ErrStat2, ErrMsg2 ) @@ -5495,14 +5405,12 @@ SUBROUTINE StC_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM ENDIF END SUBROUTINE StC_CopyOutput - SUBROUTINE StC_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE StC_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(StC_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyOutput' @@ -5510,12 +5418,6 @@ SUBROUTINE StC_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%Mesh)) THEN DO i1 = LBOUND(OutputData%Mesh,1), UBOUND(OutputData%Mesh,1) CALL MeshDestroy( OutputData%Mesh(i1), ErrStat2, ErrMsg2 ) diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index b6dfcc095e..c57f414fd8 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -310,7 +310,7 @@ MODULE SubDyn_Types TYPE(MeshAuxDataType) , DIMENSION(:), ALLOCATABLE :: MoutLst !< List of user requested members and nodes [-] TYPE(MeshAuxDataType) , DIMENSION(:), ALLOCATABLE :: MoutLst2 !< List of all member joint nodes and elements for output [-] TYPE(MeshAuxDataType) , DIMENSION(:), ALLOCATABLE :: MoutLst3 !< List of all member joint nodes and elements for output [-] - TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< An array holding names, units, and indices of all of the selected output channels. logical [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< An array holding names, units, and indices of all of the selected output channels. # logical [-] LOGICAL :: OutAll !< Flag to output or not all joint forces [-] INTEGER(IntKi) :: OutCBModes !< Flag to output CB and Guyan modes to a given format [-] INTEGER(IntKi) :: OutFEMModes !< Flag to output FEM modes to a given format [-] @@ -351,9 +351,6 @@ SUBROUTINE SD_CopyIList( SrcIListData, DstIListData, CtrlCode, ErrStat, ErrMsg ) ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyIList' @@ -374,14 +371,12 @@ SUBROUTINE SD_CopyIList( SrcIListData, DstIListData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SD_CopyIList - SUBROUTINE SD_DestroyIList( IListData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SD_DestroyIList( IListData, ErrStat, ErrMsg ) TYPE(IList), INTENT(INOUT) :: IListData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyIList' @@ -389,12 +384,6 @@ SUBROUTINE SD_DestroyIList( IListData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(IListData%List)) THEN DEALLOCATE(IListData%List) ENDIF @@ -498,9 +487,6 @@ SUBROUTINE SD_UnPackIList( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackIList' @@ -660,14 +646,12 @@ SUBROUTINE SD_CopyMeshAuxDataType( SrcMeshAuxDataTypeData, DstMeshAuxDataTypeDat ENDIF END SUBROUTINE SD_CopyMeshAuxDataType - SUBROUTINE SD_DestroyMeshAuxDataType( MeshAuxDataTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SD_DestroyMeshAuxDataType( MeshAuxDataTypeData, ErrStat, ErrMsg ) TYPE(MeshAuxDataType), INTENT(INOUT) :: MeshAuxDataTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyMeshAuxDataType' @@ -675,12 +659,6 @@ SUBROUTINE SD_DestroyMeshAuxDataType( MeshAuxDataTypeData, ErrStat, ErrMsg, DEAL ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MeshAuxDataTypeData%NodeCnt)) THEN DEALLOCATE(MeshAuxDataTypeData%NodeCnt) ENDIF @@ -1276,14 +1254,12 @@ SUBROUTINE SD_CopyCB_MatArrays( SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCo ENDIF END SUBROUTINE SD_CopyCB_MatArrays - SUBROUTINE SD_DestroyCB_MatArrays( CB_MatArraysData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SD_DestroyCB_MatArrays( CB_MatArraysData, ErrStat, ErrMsg ) TYPE(CB_MatArrays), INTENT(INOUT) :: CB_MatArraysData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyCB_MatArrays' @@ -1291,12 +1267,6 @@ SUBROUTINE SD_DestroyCB_MatArrays( CB_MatArraysData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(CB_MatArraysData%MBB)) THEN DEALLOCATE(CB_MatArraysData%MBB) ENDIF @@ -1722,14 +1692,12 @@ SUBROUTINE SD_CopyElemPropType( SrcElemPropTypeData, DstElemPropTypeData, CtrlCo DstElemPropTypeData%DirCos = SrcElemPropTypeData%DirCos END SUBROUTINE SD_CopyElemPropType - SUBROUTINE SD_DestroyElemPropType( ElemPropTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SD_DestroyElemPropType( ElemPropTypeData, ErrStat, ErrMsg ) TYPE(ElemPropType), INTENT(INOUT) :: ElemPropTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyElemPropType' @@ -1737,12 +1705,6 @@ SUBROUTINE SD_DestroyElemPropType( ElemPropTypeData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SD_DestroyElemPropType SUBROUTINE SD_PackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1977,14 +1939,12 @@ SUBROUTINE SD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%Linearize = SrcInitInputData%Linearize END SUBROUTINE SD_CopyInitInput - SUBROUTINE SD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(SD_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitInput' @@ -1992,12 +1952,6 @@ SUBROUTINE SD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitInputData%SoilStiffness)) THEN DEALLOCATE(InitInputData%SoilStiffness) ENDIF @@ -2445,14 +2399,12 @@ SUBROUTINE SD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er ENDIF END SUBROUTINE SD_CopyInitOutput - SUBROUTINE SD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(SD_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitOutput' @@ -2460,19 +2412,13 @@ SUBROUTINE SD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) ENDIF IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN DEALLOCATE(InitOutputData%WriteOutputUnt) ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(InitOutputData%LinNames_y)) THEN DEALLOCATE(InitOutputData%LinNames_y) @@ -2550,7 +2496,7 @@ SUBROUTINE SD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2672,7 +2618,7 @@ SUBROUTINE SD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END DO ! I END DO END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2943,7 +2889,7 @@ SUBROUTINE SD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3522,14 +3468,12 @@ SUBROUTINE SD_CopyInitType( SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%SSSum = SrcInitTypeData%SSSum END SUBROUTINE SD_CopyInitType - SUBROUTINE SD_DestroyInitType( InitTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SD_DestroyInitType( InitTypeData, ErrStat, ErrMsg ) TYPE(SD_InitType), INTENT(INOUT) :: InitTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitType' @@ -3537,12 +3481,6 @@ SUBROUTINE SD_DestroyInitType( InitTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitTypeData%Joints)) THEN DEALLOCATE(InitTypeData%Joints) ENDIF @@ -5138,14 +5076,12 @@ SUBROUTINE SD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrSt ENDIF END SUBROUTINE SD_CopyContState - SUBROUTINE SD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SD_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(SD_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyContState' @@ -5153,12 +5089,6 @@ SUBROUTINE SD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ContStateData%qm)) THEN DEALLOCATE(ContStateData%qm) ENDIF @@ -5353,14 +5283,12 @@ SUBROUTINE SD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState END SUBROUTINE SD_CopyDiscState - SUBROUTINE SD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(SD_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyDiscState' @@ -5368,12 +5296,6 @@ SUBROUTINE SD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SD_DestroyDiscState SUBROUTINE SD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -5490,14 +5412,12 @@ SUBROUTINE SD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE SD_CopyConstrState - SUBROUTINE SD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(SD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyConstrState' @@ -5505,12 +5425,6 @@ SUBROUTINE SD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SD_DestroyConstrState SUBROUTINE SD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -5644,14 +5558,12 @@ SUBROUTINE SD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%n = SrcOtherStateData%n END SUBROUTINE SD_CopyOtherState - SUBROUTINE SD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(SD_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyOtherState' @@ -5659,15 +5571,9 @@ SUBROUTINE SD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OtherStateData%xdot)) THEN DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL SD_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(OtherStateData%xdot) @@ -6203,14 +6109,12 @@ SUBROUTINE SD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SD_CopyMisc - SUBROUTINE SD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SD_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(SD_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyMisc' @@ -6218,12 +6122,6 @@ SUBROUTINE SD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MiscData%qmdotdot)) THEN DEALLOCATE(MiscData%qmdotdot) ENDIF @@ -8212,14 +8110,12 @@ SUBROUTINE SD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%RotStates = SrcParamData%RotStates END SUBROUTINE SD_CopyParam - SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(SD_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyParam' @@ -8227,18 +8123,12 @@ SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%Elems)) THEN DEALLOCATE(ParamData%Elems) ENDIF IF (ALLOCATED(ParamData%ElemProps)) THEN DO i1 = LBOUND(ParamData%ElemProps,1), UBOUND(ParamData%ElemProps,1) - CALL SD_Destroyelemproptype( ParamData%ElemProps(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyElemPropType( ParamData%ElemProps(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%ElemProps) @@ -8260,14 +8150,14 @@ SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(ParamData%NodesDOF)) THEN DO i1 = LBOUND(ParamData%NodesDOF,1), UBOUND(ParamData%NodesDOF,1) - CALL SD_Destroyilist( ParamData%NodesDOF(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyIList( ParamData%NodesDOF(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%NodesDOF) ENDIF IF (ALLOCATED(ParamData%NodesDOFred)) THEN DO i1 = LBOUND(ParamData%NodesDOFred,1), UBOUND(ParamData%NodesDOFred,1) - CALL SD_Destroyilist( ParamData%NodesDOFred(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyIList( ParamData%NodesDOFred(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%NodesDOFred) @@ -8406,28 +8296,28 @@ SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(ParamData%MoutLst)) THEN DO i1 = LBOUND(ParamData%MoutLst,1), UBOUND(ParamData%MoutLst,1) - CALL SD_Destroymeshauxdatatype( ParamData%MoutLst(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyMeshAuxDataType( ParamData%MoutLst(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%MoutLst) ENDIF IF (ALLOCATED(ParamData%MoutLst2)) THEN DO i1 = LBOUND(ParamData%MoutLst2,1), UBOUND(ParamData%MoutLst2,1) - CALL SD_Destroymeshauxdatatype( ParamData%MoutLst2(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyMeshAuxDataType( ParamData%MoutLst2(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%MoutLst2) ENDIF IF (ALLOCATED(ParamData%MoutLst3)) THEN DO i1 = LBOUND(ParamData%MoutLst3,1), UBOUND(ParamData%MoutLst3,1) - CALL SD_Destroymeshauxdatatype( ParamData%MoutLst3(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SD_DestroyMeshAuxDataType( ParamData%MoutLst3(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%MoutLst3) ENDIF IF (ALLOCATED(ParamData%OutParam)) THEN DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ParamData%OutParam) @@ -8491,7 +8381,7 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%ElemProps,1), UBOUND(InData%ElemProps,1) Int_BufSz = Int_BufSz + 3 ! ElemProps: size of buffers for each call to pack subtype - CALL SD_Packelemproptype( Re_Buf, Db_Buf, Int_Buf, InData%ElemProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ElemProps + CALL SD_PackElemPropType( Re_Buf, Db_Buf, Int_Buf, InData%ElemProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ElemProps CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8540,7 +8430,7 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*1 ! NodesDOF upper/lower bounds for each dimension DO i1 = LBOUND(InData%NodesDOF,1), UBOUND(InData%NodesDOF,1) Int_BufSz = Int_BufSz + 3 ! NodesDOF: size of buffers for each call to pack subtype - CALL SD_Packilist( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NodesDOF + CALL SD_PackIList( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NodesDOF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8563,7 +8453,7 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*1 ! NodesDOFred upper/lower bounds for each dimension DO i1 = LBOUND(InData%NodesDOFred,1), UBOUND(InData%NodesDOFred,1) Int_BufSz = Int_BufSz + 3 ! NodesDOFred: size of buffers for each call to pack subtype - CALL SD_Packilist( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOFred(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NodesDOFred + CALL SD_PackIList( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOFred(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NodesDOFred CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8833,7 +8723,7 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*1 ! MoutLst upper/lower bounds for each dimension DO i1 = LBOUND(InData%MoutLst,1), UBOUND(InData%MoutLst,1) Int_BufSz = Int_BufSz + 3 ! MoutLst: size of buffers for each call to pack subtype - CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MoutLst + CALL SD_PackMeshAuxDataType( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MoutLst CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8856,7 +8746,7 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*1 ! MoutLst2 upper/lower bounds for each dimension DO i1 = LBOUND(InData%MoutLst2,1), UBOUND(InData%MoutLst2,1) Int_BufSz = Int_BufSz + 3 ! MoutLst2: size of buffers for each call to pack subtype - CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MoutLst2 + CALL SD_PackMeshAuxDataType( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MoutLst2 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8879,7 +8769,7 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*1 ! MoutLst3 upper/lower bounds for each dimension DO i1 = LBOUND(InData%MoutLst3,1), UBOUND(InData%MoutLst3,1) Int_BufSz = Int_BufSz + 3 ! MoutLst3: size of buffers for each call to pack subtype - CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst3(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MoutLst3 + CALL SD_PackMeshAuxDataType( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst3(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MoutLst3 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8902,7 +8792,7 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9009,7 +8899,7 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%ElemProps,1), UBOUND(InData%ElemProps,1) - CALL SD_Packelemproptype( Re_Buf, Db_Buf, Int_Buf, InData%ElemProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! ElemProps + CALL SD_PackElemPropType( Re_Buf, Db_Buf, Int_Buf, InData%ElemProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! ElemProps CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9142,7 +9032,7 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%NodesDOF,1), UBOUND(InData%NodesDOF,1) - CALL SD_Packilist( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOF(i1), ErrStat2, ErrMsg2, OnlySize ) ! NodesDOF + CALL SD_PackIList( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOF(i1), ErrStat2, ErrMsg2, OnlySize ) ! NodesDOF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9183,7 +9073,7 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%NodesDOFred,1), UBOUND(InData%NodesDOFred,1) - CALL SD_Packilist( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOFred(i1), ErrStat2, ErrMsg2, OnlySize ) ! NodesDOFred + CALL SD_PackIList( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOFred(i1), ErrStat2, ErrMsg2, OnlySize ) ! NodesDOFred CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10089,7 +9979,7 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%MoutLst,1), UBOUND(InData%MoutLst,1) - CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! MoutLst + CALL SD_PackMeshAuxDataType( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! MoutLst CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10130,7 +10020,7 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%MoutLst2,1), UBOUND(InData%MoutLst2,1) - CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst2(i1), ErrStat2, ErrMsg2, OnlySize ) ! MoutLst2 + CALL SD_PackMeshAuxDataType( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst2(i1), ErrStat2, ErrMsg2, OnlySize ) ! MoutLst2 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10171,7 +10061,7 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%MoutLst3,1), UBOUND(InData%MoutLst3,1) - CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst3(i1), ErrStat2, ErrMsg2, OnlySize ) ! MoutLst3 + CALL SD_PackMeshAuxDataType( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst3(i1), ErrStat2, ErrMsg2, OnlySize ) ! MoutLst3 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10212,7 +10102,7 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10411,7 +10301,7 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SD_Unpackelemproptype( Re_Buf, Db_Buf, Int_Buf, OutData%ElemProps(i1), ErrStat2, ErrMsg2 ) ! ElemProps + CALL SD_UnpackElemPropType( Re_Buf, Db_Buf, Int_Buf, OutData%ElemProps(i1), ErrStat2, ErrMsg2 ) ! ElemProps CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10574,7 +10464,7 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SD_Unpackilist( Re_Buf, Db_Buf, Int_Buf, OutData%NodesDOF(i1), ErrStat2, ErrMsg2 ) ! NodesDOF + CALL SD_UnpackIList( Re_Buf, Db_Buf, Int_Buf, OutData%NodesDOF(i1), ErrStat2, ErrMsg2 ) ! NodesDOF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10630,7 +10520,7 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SD_Unpackilist( Re_Buf, Db_Buf, Int_Buf, OutData%NodesDOFred(i1), ErrStat2, ErrMsg2 ) ! NodesDOFred + CALL SD_UnpackIList( Re_Buf, Db_Buf, Int_Buf, OutData%NodesDOFred(i1), ErrStat2, ErrMsg2 ) ! NodesDOFred CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11683,7 +11573,7 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SD_Unpackmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, OutData%MoutLst(i1), ErrStat2, ErrMsg2 ) ! MoutLst + CALL SD_UnpackMeshAuxDataType( Re_Buf, Db_Buf, Int_Buf, OutData%MoutLst(i1), ErrStat2, ErrMsg2 ) ! MoutLst CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11739,7 +11629,7 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SD_Unpackmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, OutData%MoutLst2(i1), ErrStat2, ErrMsg2 ) ! MoutLst2 + CALL SD_UnpackMeshAuxDataType( Re_Buf, Db_Buf, Int_Buf, OutData%MoutLst2(i1), ErrStat2, ErrMsg2 ) ! MoutLst2 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11795,7 +11685,7 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SD_Unpackmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, OutData%MoutLst3(i1), ErrStat2, ErrMsg2 ) ! MoutLst3 + CALL SD_UnpackMeshAuxDataType( Re_Buf, Db_Buf, Int_Buf, OutData%MoutLst3(i1), ErrStat2, ErrMsg2 ) ! MoutLst3 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11851,7 +11741,7 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11964,14 +11854,12 @@ SUBROUTINE SD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SD_CopyInput - SUBROUTINE SD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SD_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(SD_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInput' @@ -11979,12 +11867,6 @@ SUBROUTINE SD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( InputData%TPMesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL MeshDestroy( InputData%LMesh, ErrStat2, ErrMsg2 ) @@ -12334,14 +12216,12 @@ SUBROUTINE SD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs ENDIF END SUBROUTINE SD_CopyOutput - SUBROUTINE SD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SD_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(SD_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyOutput' @@ -12349,12 +12229,6 @@ SUBROUTINE SD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - CALL MeshDestroy( OutputData%Y1Mesh, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL MeshDestroy( OutputData%Y2Mesh, ErrStat2, ErrMsg2 ) diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index 2a44f59489..5872d21f0f 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -31,7 +31,6 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE SCDataEx_Types !--------------------------------------------------------------------------------------------------------------------------------- -!USE, INTRINSIC :: ISO_C_Binding USE NWTC_Library IMPLICIT NONE ! ========= SC_DX_InitInputType_C ======= @@ -101,7 +100,6 @@ SUBROUTINE SC_DX_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_CopyInitInput' @@ -116,14 +114,12 @@ SUBROUTINE SC_DX_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%C_obj%NumCtrl2SC = SrcInitInputData%C_obj%NumCtrl2SC END SUBROUTINE SC_DX_CopyInitInput - SUBROUTINE SC_DX_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SC_DX_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(SC_DX_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyInitInput' @@ -131,12 +127,6 @@ SUBROUTINE SC_DX_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpoi ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SC_DX_DestroyInitInput SUBROUTINE SC_DX_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -227,7 +217,6 @@ SUBROUTINE SC_DX_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_UnPackInitInput' @@ -311,14 +300,12 @@ SUBROUTINE SC_DX_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE SC_DX_CopyInitOutput - SUBROUTINE SC_DX_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SC_DX_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyInitOutput' @@ -326,13 +313,7 @@ SUBROUTINE SC_DX_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SC_DX_DestroyInitOutput @@ -373,7 +354,7 @@ SUBROUTINE SC_DX_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -418,7 +399,7 @@ SUBROUTINE SC_DX_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -507,7 +488,7 @@ SUBROUTINE SC_DX_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -568,14 +549,12 @@ SUBROUTINE SC_DX_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%C_obj%useSC = SrcParamData%C_obj%useSC END SUBROUTINE SC_DX_CopyParam - SUBROUTINE SC_DX_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SC_DX_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(SC_DX_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyParam' @@ -583,12 +562,6 @@ SUBROUTINE SC_DX_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SC_DX_DestroyParam SUBROUTINE SC_DX_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -751,22 +724,20 @@ SUBROUTINE SC_DX_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%toSC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%toSC_Len = SIZE(DstInputData%toSC) - IF (DstInputData%c_obj%toSC_Len > 0) & - DstInputData%c_obj%toSC = C_LOC( DstInputData%toSC( i1_l ) ) + DstInputData%C_obj%toSC_Len = SIZE(DstInputData%toSC) + IF (DstInputData%C_obj%toSC_Len > 0) & + DstInputData%C_obj%toSC = C_LOC( DstInputData%toSC( i1_l ) ) END IF DstInputData%toSC = SrcInputData%toSC ENDIF END SUBROUTINE SC_DX_CopyInput - SUBROUTINE SC_DX_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SC_DX_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(SC_DX_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyInput' @@ -774,16 +745,8 @@ SUBROUTINE SC_DX_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ASSOCIATED(InputData%toSC)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%toSC) - InputData%toSC => NULL() InputData%C_obj%toSC = C_NULL_PTR InputData%C_obj%toSC_Len = 0 ENDIF @@ -915,9 +878,9 @@ SUBROUTINE SC_DX_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%toSC_Len = SIZE(OutData%toSC) - IF (OutData%c_obj%toSC_Len > 0) & - OutData%c_obj%toSC = C_LOC( OutData%toSC( i1_l ) ) + OutData%C_obj%toSC_Len = SIZE(OutData%toSC) + IF (OutData%C_obj%toSC_Len > 0) & + OutData%C_obj%toSC = C_LOC( OutData%toSC( i1_l ) ) DO i1 = LBOUND(OutData%toSC,1), UBOUND(OutData%toSC,1) OutData%toSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -970,12 +933,12 @@ SUBROUTINE SC_DX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ! -- toSC Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%toSC)) THEN - InputData%c_obj%toSC_Len = 0 - InputData%c_obj%toSC = C_NULL_PTR + InputData%C_obj%toSC_Len = 0 + InputData%C_obj%toSC = C_NULL_PTR ELSE - InputData%c_obj%toSC_Len = SIZE(InputData%toSC) - IF (InputData%c_obj%toSC_Len > 0) & - InputData%c_obj%toSC = C_LOC( InputData%toSC( LBOUND(InputData%toSC,1) ) ) + InputData%C_obj%toSC_Len = SIZE(InputData%toSC) + IF (InputData%C_obj%toSC_Len > 0) & + InputData%C_obj%toSC = C_LOC( InputData%toSC( LBOUND(InputData%toSC,1) ) ) END IF END IF END SUBROUTINE SC_DX_F2C_CopyInput @@ -1004,9 +967,9 @@ SUBROUTINE SC_DX_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%fromSC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOutputData%c_obj%fromSC_Len = SIZE(DstOutputData%fromSC) - IF (DstOutputData%c_obj%fromSC_Len > 0) & - DstOutputData%c_obj%fromSC = C_LOC( DstOutputData%fromSC( i1_l ) ) + DstOutputData%C_obj%fromSC_Len = SIZE(DstOutputData%fromSC) + IF (DstOutputData%C_obj%fromSC_Len > 0) & + DstOutputData%C_obj%fromSC = C_LOC( DstOutputData%fromSC( i1_l ) ) END IF DstOutputData%fromSC = SrcOutputData%fromSC ENDIF @@ -1019,22 +982,20 @@ SUBROUTINE SC_DX_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%fromSCglob.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOutputData%c_obj%fromSCglob_Len = SIZE(DstOutputData%fromSCglob) - IF (DstOutputData%c_obj%fromSCglob_Len > 0) & - DstOutputData%c_obj%fromSCglob = C_LOC( DstOutputData%fromSCglob( i1_l ) ) + DstOutputData%C_obj%fromSCglob_Len = SIZE(DstOutputData%fromSCglob) + IF (DstOutputData%C_obj%fromSCglob_Len > 0) & + DstOutputData%C_obj%fromSCglob = C_LOC( DstOutputData%fromSCglob( i1_l ) ) END IF DstOutputData%fromSCglob = SrcOutputData%fromSCglob ENDIF END SUBROUTINE SC_DX_CopyOutput - SUBROUTINE SC_DX_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SC_DX_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(SC_DX_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyOutput' @@ -1042,23 +1003,13 @@ SUBROUTINE SC_DX_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ASSOCIATED(OutputData%fromSC)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OutputData%fromSC) - OutputData%fromSC => NULL() OutputData%C_obj%fromSC = C_NULL_PTR OutputData%C_obj%fromSC_Len = 0 ENDIF IF (ASSOCIATED(OutputData%fromSCglob)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OutputData%fromSCglob) - OutputData%fromSCglob => NULL() OutputData%C_obj%fromSCglob = C_NULL_PTR OutputData%C_obj%fromSCglob_Len = 0 ENDIF @@ -1210,9 +1161,9 @@ SUBROUTINE SC_DX_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%fromSC_Len = SIZE(OutData%fromSC) - IF (OutData%c_obj%fromSC_Len > 0) & - OutData%c_obj%fromSC = C_LOC( OutData%fromSC( i1_l ) ) + OutData%C_obj%fromSC_Len = SIZE(OutData%fromSC) + IF (OutData%C_obj%fromSC_Len > 0) & + OutData%C_obj%fromSC = C_LOC( OutData%fromSC( i1_l ) ) DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) OutData%fromSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -1231,9 +1182,9 @@ SUBROUTINE SC_DX_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%fromSCglob_Len = SIZE(OutData%fromSCglob) - IF (OutData%c_obj%fromSCglob_Len > 0) & - OutData%c_obj%fromSCglob = C_LOC( OutData%fromSCglob( i1_l ) ) + OutData%C_obj%fromSCglob_Len = SIZE(OutData%fromSCglob) + IF (OutData%C_obj%fromSCglob_Len > 0) & + OutData%C_obj%fromSCglob = C_LOC( OutData%fromSCglob( i1_l ) ) DO i1 = LBOUND(OutData%fromSCglob,1), UBOUND(OutData%fromSCglob,1) OutData%fromSCglob(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -1295,24 +1246,24 @@ SUBROUTINE SC_DX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ! -- fromSC Output Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OutputData%fromSC)) THEN - OutputData%c_obj%fromSC_Len = 0 - OutputData%c_obj%fromSC = C_NULL_PTR + OutputData%C_obj%fromSC_Len = 0 + OutputData%C_obj%fromSC = C_NULL_PTR ELSE - OutputData%c_obj%fromSC_Len = SIZE(OutputData%fromSC) - IF (OutputData%c_obj%fromSC_Len > 0) & - OutputData%c_obj%fromSC = C_LOC( OutputData%fromSC( LBOUND(OutputData%fromSC,1) ) ) + OutputData%C_obj%fromSC_Len = SIZE(OutputData%fromSC) + IF (OutputData%C_obj%fromSC_Len > 0) & + OutputData%C_obj%fromSC = C_LOC( OutputData%fromSC( LBOUND(OutputData%fromSC,1) ) ) END IF END IF ! -- fromSCglob Output Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OutputData%fromSCglob)) THEN - OutputData%c_obj%fromSCglob_Len = 0 - OutputData%c_obj%fromSCglob = C_NULL_PTR + OutputData%C_obj%fromSCglob_Len = 0 + OutputData%C_obj%fromSCglob = C_NULL_PTR ELSE - OutputData%c_obj%fromSCglob_Len = SIZE(OutputData%fromSCglob) - IF (OutputData%c_obj%fromSCglob_Len > 0) & - OutputData%c_obj%fromSCglob = C_LOC( OutputData%fromSCglob( LBOUND(OutputData%fromSCglob,1) ) ) + OutputData%C_obj%fromSCglob_Len = SIZE(OutputData%fromSCglob) + IF (OutputData%C_obj%fromSCglob_Len > 0) & + OutputData%C_obj%fromSCglob = C_LOC( OutputData%fromSCglob( LBOUND(OutputData%fromSCglob,1) ) ) END IF END IF END SUBROUTINE SC_DX_F2C_CopyOutput diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 10ae1505c9..ef7d360986 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -31,7 +31,6 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE SuperController_Types !--------------------------------------------------------------------------------------------------------------------------------- -!USE, INTRINSIC :: ISO_C_Binding USE NWTC_Library IMPLICIT NONE ! ========= SC_InitInputType_C ======= @@ -189,7 +188,6 @@ SUBROUTINE SC_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyInitInput' @@ -202,14 +200,12 @@ SUBROUTINE SC_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%C_obj%DLL_FileName = SrcInitInputData%C_obj%DLL_FileName END SUBROUTINE SC_CopyInitInput - SUBROUTINE SC_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SC_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyInitInput' @@ -217,12 +213,6 @@ SUBROUTINE SC_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SC_DestroyInitInput SUBROUTINE SC_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -312,7 +302,6 @@ SUBROUTINE SC_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackInitInput' @@ -401,14 +390,12 @@ SUBROUTINE SC_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%C_obj%NumSC2CtrlGlob = SrcInitOutputData%C_obj%NumSC2CtrlGlob END SUBROUTINE SC_CopyInitOutput - SUBROUTINE SC_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SC_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyInitOutput' @@ -416,13 +403,7 @@ SUBROUTINE SC_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SC_DestroyInitOutput @@ -463,7 +444,7 @@ SUBROUTINE SC_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -512,7 +493,7 @@ SUBROUTINE SC_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -609,7 +590,7 @@ SUBROUTINE SC_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -716,9 +697,9 @@ SUBROUTINE SC_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ParamGlobal.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstParamData%c_obj%ParamGlobal_Len = SIZE(DstParamData%ParamGlobal) - IF (DstParamData%c_obj%ParamGlobal_Len > 0) & - DstParamData%c_obj%ParamGlobal = C_LOC( DstParamData%ParamGlobal( i1_l ) ) + DstParamData%C_obj%ParamGlobal_Len = SIZE(DstParamData%ParamGlobal) + IF (DstParamData%C_obj%ParamGlobal_Len > 0) & + DstParamData%C_obj%ParamGlobal = C_LOC( DstParamData%ParamGlobal( i1_l ) ) END IF DstParamData%ParamGlobal = SrcParamData%ParamGlobal ENDIF @@ -731,23 +712,21 @@ SUBROUTINE SC_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ParamTurbine.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstParamData%c_obj%ParamTurbine_Len = SIZE(DstParamData%ParamTurbine) - IF (DstParamData%c_obj%ParamTurbine_Len > 0) & - DstParamData%c_obj%ParamTurbine = C_LOC( DstParamData%ParamTurbine( i1_l ) ) + DstParamData%C_obj%ParamTurbine_Len = SIZE(DstParamData%ParamTurbine) + IF (DstParamData%C_obj%ParamTurbine_Len > 0) & + DstParamData%C_obj%ParamTurbine = C_LOC( DstParamData%ParamTurbine( i1_l ) ) END IF DstParamData%ParamTurbine = SrcParamData%ParamTurbine ENDIF DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt END SUBROUTINE SC_CopyParam - SUBROUTINE SC_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SC_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyParam' @@ -755,23 +734,13 @@ SUBROUTINE SC_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ASSOCIATED(ParamData%ParamGlobal)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(ParamData%ParamGlobal) - ParamData%ParamGlobal => NULL() ParamData%C_obj%ParamGlobal = C_NULL_PTR ParamData%C_obj%ParamGlobal_Len = 0 ENDIF IF (ASSOCIATED(ParamData%ParamTurbine)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(ParamData%ParamTurbine) - ParamData%ParamTurbine => NULL() ParamData%C_obj%ParamTurbine = C_NULL_PTR ParamData%C_obj%ParamTurbine_Len = 0 ENDIF @@ -1031,9 +1000,9 @@ SUBROUTINE SC_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ParamGlobal.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%ParamGlobal_Len = SIZE(OutData%ParamGlobal) - IF (OutData%c_obj%ParamGlobal_Len > 0) & - OutData%c_obj%ParamGlobal = C_LOC( OutData%ParamGlobal( i1_l ) ) + OutData%C_obj%ParamGlobal_Len = SIZE(OutData%ParamGlobal) + IF (OutData%C_obj%ParamGlobal_Len > 0) & + OutData%C_obj%ParamGlobal = C_LOC( OutData%ParamGlobal( i1_l ) ) DO i1 = LBOUND(OutData%ParamGlobal,1), UBOUND(OutData%ParamGlobal,1) OutData%ParamGlobal(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -1052,9 +1021,9 @@ SUBROUTINE SC_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ParamTurbine.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%ParamTurbine_Len = SIZE(OutData%ParamTurbine) - IF (OutData%c_obj%ParamTurbine_Len > 0) & - OutData%c_obj%ParamTurbine = C_LOC( OutData%ParamTurbine( i1_l ) ) + OutData%C_obj%ParamTurbine_Len = SIZE(OutData%ParamTurbine) + IF (OutData%C_obj%ParamTurbine_Len > 0) & + OutData%C_obj%ParamTurbine = C_LOC( OutData%ParamTurbine( i1_l ) ) DO i1 = LBOUND(OutData%ParamTurbine,1), UBOUND(OutData%ParamTurbine,1) OutData%ParamTurbine(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -1176,24 +1145,24 @@ SUBROUTINE SC_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ! -- ParamGlobal Param Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(ParamData%ParamGlobal)) THEN - ParamData%c_obj%ParamGlobal_Len = 0 - ParamData%c_obj%ParamGlobal = C_NULL_PTR + ParamData%C_obj%ParamGlobal_Len = 0 + ParamData%C_obj%ParamGlobal = C_NULL_PTR ELSE - ParamData%c_obj%ParamGlobal_Len = SIZE(ParamData%ParamGlobal) - IF (ParamData%c_obj%ParamGlobal_Len > 0) & - ParamData%c_obj%ParamGlobal = C_LOC( ParamData%ParamGlobal( LBOUND(ParamData%ParamGlobal,1) ) ) + ParamData%C_obj%ParamGlobal_Len = SIZE(ParamData%ParamGlobal) + IF (ParamData%C_obj%ParamGlobal_Len > 0) & + ParamData%C_obj%ParamGlobal = C_LOC( ParamData%ParamGlobal( LBOUND(ParamData%ParamGlobal,1) ) ) END IF END IF ! -- ParamTurbine Param Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(ParamData%ParamTurbine)) THEN - ParamData%c_obj%ParamTurbine_Len = 0 - ParamData%c_obj%ParamTurbine = C_NULL_PTR + ParamData%C_obj%ParamTurbine_Len = 0 + ParamData%C_obj%ParamTurbine = C_NULL_PTR ELSE - ParamData%c_obj%ParamTurbine_Len = SIZE(ParamData%ParamTurbine) - IF (ParamData%c_obj%ParamTurbine_Len > 0) & - ParamData%c_obj%ParamTurbine = C_LOC( ParamData%ParamTurbine( LBOUND(ParamData%ParamTurbine,1) ) ) + ParamData%C_obj%ParamTurbine_Len = SIZE(ParamData%ParamTurbine) + IF (ParamData%C_obj%ParamTurbine_Len > 0) & + ParamData%C_obj%ParamTurbine = C_LOC( ParamData%ParamTurbine( LBOUND(ParamData%ParamTurbine,1) ) ) END IF END IF END SUBROUTINE SC_F2C_CopyParam @@ -1222,9 +1191,9 @@ SUBROUTINE SC_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Global.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstDiscStateData%c_obj%Global_Len = SIZE(DstDiscStateData%Global) - IF (DstDiscStateData%c_obj%Global_Len > 0) & - DstDiscStateData%c_obj%Global = C_LOC( DstDiscStateData%Global( i1_l ) ) + DstDiscStateData%C_obj%Global_Len = SIZE(DstDiscStateData%Global) + IF (DstDiscStateData%C_obj%Global_Len > 0) & + DstDiscStateData%C_obj%Global = C_LOC( DstDiscStateData%Global( i1_l ) ) END IF DstDiscStateData%Global = SrcDiscStateData%Global ENDIF @@ -1237,22 +1206,20 @@ SUBROUTINE SC_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Turbine.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstDiscStateData%c_obj%Turbine_Len = SIZE(DstDiscStateData%Turbine) - IF (DstDiscStateData%c_obj%Turbine_Len > 0) & - DstDiscStateData%c_obj%Turbine = C_LOC( DstDiscStateData%Turbine( i1_l ) ) + DstDiscStateData%C_obj%Turbine_Len = SIZE(DstDiscStateData%Turbine) + IF (DstDiscStateData%C_obj%Turbine_Len > 0) & + DstDiscStateData%C_obj%Turbine = C_LOC( DstDiscStateData%Turbine( i1_l ) ) END IF DstDiscStateData%Turbine = SrcDiscStateData%Turbine ENDIF END SUBROUTINE SC_CopyDiscState - SUBROUTINE SC_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SC_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyDiscState' @@ -1260,23 +1227,13 @@ SUBROUTINE SC_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ASSOCIATED(DiscStateData%Global)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(DiscStateData%Global) - DiscStateData%Global => NULL() DiscStateData%C_obj%Global = C_NULL_PTR DiscStateData%C_obj%Global_Len = 0 ENDIF IF (ASSOCIATED(DiscStateData%Turbine)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(DiscStateData%Turbine) - DiscStateData%Turbine => NULL() DiscStateData%C_obj%Turbine = C_NULL_PTR DiscStateData%C_obj%Turbine_Len = 0 ENDIF @@ -1428,9 +1385,9 @@ SUBROUTINE SC_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Global.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%Global_Len = SIZE(OutData%Global) - IF (OutData%c_obj%Global_Len > 0) & - OutData%c_obj%Global = C_LOC( OutData%Global( i1_l ) ) + OutData%C_obj%Global_Len = SIZE(OutData%Global) + IF (OutData%C_obj%Global_Len > 0) & + OutData%C_obj%Global = C_LOC( OutData%Global( i1_l ) ) DO i1 = LBOUND(OutData%Global,1), UBOUND(OutData%Global,1) OutData%Global(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -1449,9 +1406,9 @@ SUBROUTINE SC_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turbine.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%Turbine_Len = SIZE(OutData%Turbine) - IF (OutData%c_obj%Turbine_Len > 0) & - OutData%c_obj%Turbine = C_LOC( OutData%Turbine( i1_l ) ) + OutData%C_obj%Turbine_Len = SIZE(OutData%Turbine) + IF (OutData%C_obj%Turbine_Len > 0) & + OutData%C_obj%Turbine = C_LOC( OutData%Turbine( i1_l ) ) DO i1 = LBOUND(OutData%Turbine,1), UBOUND(OutData%Turbine,1) OutData%Turbine(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -1513,24 +1470,24 @@ SUBROUTINE SC_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) ! -- Global DiscState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(DiscStateData%Global)) THEN - DiscStateData%c_obj%Global_Len = 0 - DiscStateData%c_obj%Global = C_NULL_PTR + DiscStateData%C_obj%Global_Len = 0 + DiscStateData%C_obj%Global = C_NULL_PTR ELSE - DiscStateData%c_obj%Global_Len = SIZE(DiscStateData%Global) - IF (DiscStateData%c_obj%Global_Len > 0) & - DiscStateData%c_obj%Global = C_LOC( DiscStateData%Global( LBOUND(DiscStateData%Global,1) ) ) + DiscStateData%C_obj%Global_Len = SIZE(DiscStateData%Global) + IF (DiscStateData%C_obj%Global_Len > 0) & + DiscStateData%C_obj%Global = C_LOC( DiscStateData%Global( LBOUND(DiscStateData%Global,1) ) ) END IF END IF ! -- Turbine DiscState Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(DiscStateData%Turbine)) THEN - DiscStateData%c_obj%Turbine_Len = 0 - DiscStateData%c_obj%Turbine = C_NULL_PTR + DiscStateData%C_obj%Turbine_Len = 0 + DiscStateData%C_obj%Turbine = C_NULL_PTR ELSE - DiscStateData%c_obj%Turbine_Len = SIZE(DiscStateData%Turbine) - IF (DiscStateData%c_obj%Turbine_Len > 0) & - DiscStateData%c_obj%Turbine = C_LOC( DiscStateData%Turbine( LBOUND(DiscStateData%Turbine,1) ) ) + DiscStateData%C_obj%Turbine_Len = SIZE(DiscStateData%Turbine) + IF (DiscStateData%C_obj%Turbine_Len > 0) & + DiscStateData%C_obj%Turbine = C_LOC( DiscStateData%Turbine( LBOUND(DiscStateData%Turbine,1) ) ) END IF END IF END SUBROUTINE SC_F2C_CopyDiscState @@ -1553,14 +1510,12 @@ SUBROUTINE SC_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrSt DstContStateData%C_obj%Dummy = SrcContStateData%C_obj%Dummy END SUBROUTINE SC_CopyContState - SUBROUTINE SC_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SC_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(SC_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyContState' @@ -1568,12 +1523,6 @@ SUBROUTINE SC_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SC_DestroyContState SUBROUTINE SC_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1730,14 +1679,12 @@ SUBROUTINE SC_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%C_obj%Dummy = SrcConstrStateData%C_obj%Dummy END SUBROUTINE SC_CopyConstrState - SUBROUTINE SC_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SC_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(SC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyConstrState' @@ -1745,12 +1692,6 @@ SUBROUTINE SC_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SC_DestroyConstrState SUBROUTINE SC_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1907,14 +1848,12 @@ SUBROUTINE SC_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%C_obj%Dummy = SrcMiscData%C_obj%Dummy END SUBROUTINE SC_CopyMisc - SUBROUTINE SC_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SC_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(SC_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyMisc' @@ -1922,12 +1861,6 @@ SUBROUTINE SC_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SC_DestroyMisc SUBROUTINE SC_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2084,14 +2017,12 @@ SUBROUTINE SC_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%C_obj%Dummy = SrcOtherStateData%C_obj%Dummy END SUBROUTINE SC_CopyOtherState - SUBROUTINE SC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(SC_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyOtherState' @@ -2099,12 +2030,6 @@ SUBROUTINE SC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE SC_DestroyOtherState SUBROUTINE SC_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2267,9 +2192,9 @@ SUBROUTINE SC_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%toSCglob.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%toSCglob_Len = SIZE(DstInputData%toSCglob) - IF (DstInputData%c_obj%toSCglob_Len > 0) & - DstInputData%c_obj%toSCglob = C_LOC( DstInputData%toSCglob( i1_l ) ) + DstInputData%C_obj%toSCglob_Len = SIZE(DstInputData%toSCglob) + IF (DstInputData%C_obj%toSCglob_Len > 0) & + DstInputData%C_obj%toSCglob = C_LOC( DstInputData%toSCglob( i1_l ) ) END IF DstInputData%toSCglob = SrcInputData%toSCglob ENDIF @@ -2282,22 +2207,20 @@ SUBROUTINE SC_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%toSC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstInputData%c_obj%toSC_Len = SIZE(DstInputData%toSC) - IF (DstInputData%c_obj%toSC_Len > 0) & - DstInputData%c_obj%toSC = C_LOC( DstInputData%toSC( i1_l ) ) + DstInputData%C_obj%toSC_Len = SIZE(DstInputData%toSC) + IF (DstInputData%C_obj%toSC_Len > 0) & + DstInputData%C_obj%toSC = C_LOC( DstInputData%toSC( i1_l ) ) END IF DstInputData%toSC = SrcInputData%toSC ENDIF END SUBROUTINE SC_CopyInput - SUBROUTINE SC_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SC_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(SC_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyInput' @@ -2305,23 +2228,13 @@ SUBROUTINE SC_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ASSOCIATED(InputData%toSCglob)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%toSCglob) - InputData%toSCglob => NULL() InputData%C_obj%toSCglob = C_NULL_PTR InputData%C_obj%toSCglob_Len = 0 ENDIF IF (ASSOCIATED(InputData%toSC)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%toSC) - InputData%toSC => NULL() InputData%C_obj%toSC = C_NULL_PTR InputData%C_obj%toSC_Len = 0 ENDIF @@ -2473,9 +2386,9 @@ SUBROUTINE SC_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSCglob.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%toSCglob_Len = SIZE(OutData%toSCglob) - IF (OutData%c_obj%toSCglob_Len > 0) & - OutData%c_obj%toSCglob = C_LOC( OutData%toSCglob( i1_l ) ) + OutData%C_obj%toSCglob_Len = SIZE(OutData%toSCglob) + IF (OutData%C_obj%toSCglob_Len > 0) & + OutData%C_obj%toSCglob = C_LOC( OutData%toSCglob( i1_l ) ) DO i1 = LBOUND(OutData%toSCglob,1), UBOUND(OutData%toSCglob,1) OutData%toSCglob(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -2494,9 +2407,9 @@ SUBROUTINE SC_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%toSC_Len = SIZE(OutData%toSC) - IF (OutData%c_obj%toSC_Len > 0) & - OutData%c_obj%toSC = C_LOC( OutData%toSC( i1_l ) ) + OutData%C_obj%toSC_Len = SIZE(OutData%toSC) + IF (OutData%C_obj%toSC_Len > 0) & + OutData%C_obj%toSC = C_LOC( OutData%toSC( i1_l ) ) DO i1 = LBOUND(OutData%toSC,1), UBOUND(OutData%toSC,1) OutData%toSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -2558,24 +2471,24 @@ SUBROUTINE SC_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ! -- toSCglob Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%toSCglob)) THEN - InputData%c_obj%toSCglob_Len = 0 - InputData%c_obj%toSCglob = C_NULL_PTR + InputData%C_obj%toSCglob_Len = 0 + InputData%C_obj%toSCglob = C_NULL_PTR ELSE - InputData%c_obj%toSCglob_Len = SIZE(InputData%toSCglob) - IF (InputData%c_obj%toSCglob_Len > 0) & - InputData%c_obj%toSCglob = C_LOC( InputData%toSCglob( LBOUND(InputData%toSCglob,1) ) ) + InputData%C_obj%toSCglob_Len = SIZE(InputData%toSCglob) + IF (InputData%C_obj%toSCglob_Len > 0) & + InputData%C_obj%toSCglob = C_LOC( InputData%toSCglob( LBOUND(InputData%toSCglob,1) ) ) END IF END IF ! -- toSC Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%toSC)) THEN - InputData%c_obj%toSC_Len = 0 - InputData%c_obj%toSC = C_NULL_PTR + InputData%C_obj%toSC_Len = 0 + InputData%C_obj%toSC = C_NULL_PTR ELSE - InputData%c_obj%toSC_Len = SIZE(InputData%toSC) - IF (InputData%c_obj%toSC_Len > 0) & - InputData%c_obj%toSC = C_LOC( InputData%toSC( LBOUND(InputData%toSC,1) ) ) + InputData%C_obj%toSC_Len = SIZE(InputData%toSC) + IF (InputData%C_obj%toSC_Len > 0) & + InputData%C_obj%toSC = C_LOC( InputData%toSC( LBOUND(InputData%toSC,1) ) ) END IF END IF END SUBROUTINE SC_F2C_CopyInput @@ -2604,9 +2517,9 @@ SUBROUTINE SC_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%fromSCglob.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOutputData%c_obj%fromSCglob_Len = SIZE(DstOutputData%fromSCglob) - IF (DstOutputData%c_obj%fromSCglob_Len > 0) & - DstOutputData%c_obj%fromSCglob = C_LOC( DstOutputData%fromSCglob( i1_l ) ) + DstOutputData%C_obj%fromSCglob_Len = SIZE(DstOutputData%fromSCglob) + IF (DstOutputData%C_obj%fromSCglob_Len > 0) & + DstOutputData%C_obj%fromSCglob = C_LOC( DstOutputData%fromSCglob( i1_l ) ) END IF DstOutputData%fromSCglob = SrcOutputData%fromSCglob ENDIF @@ -2619,22 +2532,20 @@ SUBROUTINE SC_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%fromSC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOutputData%c_obj%fromSC_Len = SIZE(DstOutputData%fromSC) - IF (DstOutputData%c_obj%fromSC_Len > 0) & - DstOutputData%c_obj%fromSC = C_LOC( DstOutputData%fromSC( i1_l ) ) + DstOutputData%C_obj%fromSC_Len = SIZE(DstOutputData%fromSC) + IF (DstOutputData%C_obj%fromSC_Len > 0) & + DstOutputData%C_obj%fromSC = C_LOC( DstOutputData%fromSC( i1_l ) ) END IF DstOutputData%fromSC = SrcOutputData%fromSC ENDIF END SUBROUTINE SC_CopyOutput - SUBROUTINE SC_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE SC_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(SC_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyOutput' @@ -2642,23 +2553,13 @@ SUBROUTINE SC_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ASSOCIATED(OutputData%fromSCglob)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OutputData%fromSCglob) - OutputData%fromSCglob => NULL() OutputData%C_obj%fromSCglob = C_NULL_PTR OutputData%C_obj%fromSCglob_Len = 0 ENDIF IF (ASSOCIATED(OutputData%fromSC)) THEN - IF (DEALLOCATEpointers_local) & DEALLOCATE(OutputData%fromSC) - OutputData%fromSC => NULL() OutputData%C_obj%fromSC = C_NULL_PTR OutputData%C_obj%fromSC_Len = 0 ENDIF @@ -2810,9 +2711,9 @@ SUBROUTINE SC_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%fromSCglob_Len = SIZE(OutData%fromSCglob) - IF (OutData%c_obj%fromSCglob_Len > 0) & - OutData%c_obj%fromSCglob = C_LOC( OutData%fromSCglob( i1_l ) ) + OutData%C_obj%fromSCglob_Len = SIZE(OutData%fromSCglob) + IF (OutData%C_obj%fromSCglob_Len > 0) & + OutData%C_obj%fromSCglob = C_LOC( OutData%fromSCglob( i1_l ) ) DO i1 = LBOUND(OutData%fromSCglob,1), UBOUND(OutData%fromSCglob,1) OutData%fromSCglob(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -2831,9 +2732,9 @@ SUBROUTINE SC_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%fromSC_Len = SIZE(OutData%fromSC) - IF (OutData%c_obj%fromSC_Len > 0) & - OutData%c_obj%fromSC = C_LOC( OutData%fromSC( i1_l ) ) + OutData%C_obj%fromSC_Len = SIZE(OutData%fromSC) + IF (OutData%C_obj%fromSC_Len > 0) & + OutData%C_obj%fromSC = C_LOC( OutData%fromSC( i1_l ) ) DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) OutData%fromSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) Re_Xferred = Re_Xferred + 1 @@ -2895,24 +2796,24 @@ SUBROUTINE SC_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ! -- fromSCglob Output Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OutputData%fromSCglob)) THEN - OutputData%c_obj%fromSCglob_Len = 0 - OutputData%c_obj%fromSCglob = C_NULL_PTR + OutputData%C_obj%fromSCglob_Len = 0 + OutputData%C_obj%fromSCglob = C_NULL_PTR ELSE - OutputData%c_obj%fromSCglob_Len = SIZE(OutputData%fromSCglob) - IF (OutputData%c_obj%fromSCglob_Len > 0) & - OutputData%c_obj%fromSCglob = C_LOC( OutputData%fromSCglob( LBOUND(OutputData%fromSCglob,1) ) ) + OutputData%C_obj%fromSCglob_Len = SIZE(OutputData%fromSCglob) + IF (OutputData%C_obj%fromSCglob_Len > 0) & + OutputData%C_obj%fromSCglob = C_LOC( OutputData%fromSCglob( LBOUND(OutputData%fromSCglob,1) ) ) END IF END IF ! -- fromSC Output Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(OutputData%fromSC)) THEN - OutputData%c_obj%fromSC_Len = 0 - OutputData%c_obj%fromSC = C_NULL_PTR + OutputData%C_obj%fromSC_Len = 0 + OutputData%C_obj%fromSC = C_NULL_PTR ELSE - OutputData%c_obj%fromSC_Len = SIZE(OutputData%fromSC) - IF (OutputData%c_obj%fromSC_Len > 0) & - OutputData%c_obj%fromSC = C_LOC( OutputData%fromSC( LBOUND(OutputData%fromSC,1) ) ) + OutputData%C_obj%fromSC_Len = SIZE(OutputData%fromSC) + IF (OutputData%C_obj%fromSC_Len > 0) & + OutputData%C_obj%fromSC = C_LOC( OutputData%fromSC( LBOUND(OutputData%fromSC,1) ) ) END IF END IF END SUBROUTINE SC_F2C_CopyOutput diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index 72d92c9089..a637d846de 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -237,9 +237,6 @@ SUBROUTINE WD_CopyInputFileType( SrcInputFileTypeData, DstInputFileTypeData, Ctr CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyInputFileType' @@ -280,14 +277,12 @@ SUBROUTINE WD_CopyInputFileType( SrcInputFileTypeData, DstInputFileTypeData, Ctr DstInputFileTypeData%WAT_k_Grad = SrcInputFileTypeData%WAT_k_Grad END SUBROUTINE WD_CopyInputFileType - SUBROUTINE WD_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WD_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg ) TYPE(WD_InputFileType), INTENT(INOUT) :: InputFileTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInputFileType' @@ -295,12 +290,6 @@ SUBROUTINE WD_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE WD_DestroyInputFileType SUBROUTINE WD_PackInputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -476,9 +465,6 @@ SUBROUTINE WD_UnPackInputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackInputFileType' @@ -579,14 +565,12 @@ SUBROUTINE WD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%OutFileRoot = SrcInitInputData%OutFileRoot END SUBROUTINE WD_CopyInitInput - SUBROUTINE WD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) TYPE(WD_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInitInput' @@ -594,13 +578,7 @@ SUBROUTINE WD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL WD_Destroyinputfiletype( InitInputData%InputFileData, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL WD_DestroyInputFileType( InitInputData%InputFileData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WD_DestroyInitInput @@ -641,7 +619,7 @@ SUBROUTINE WD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! InputFileData: size of buffers for each call to pack subtype - CALL WD_Packinputfiletype( Re_Buf, Db_Buf, Int_Buf, InData%InputFileData, ErrStat2, ErrMsg2, .TRUE. ) ! InputFileData + CALL WD_PackInputFileType( Re_Buf, Db_Buf, Int_Buf, InData%InputFileData, ErrStat2, ErrMsg2, .TRUE. ) ! InputFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -686,7 +664,7 @@ SUBROUTINE WD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - CALL WD_Packinputfiletype( Re_Buf, Db_Buf, Int_Buf, InData%InputFileData, ErrStat2, ErrMsg2, OnlySize ) ! InputFileData + CALL WD_PackInputFileType( Re_Buf, Db_Buf, Int_Buf, InData%InputFileData, ErrStat2, ErrMsg2, OnlySize ) ! InputFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -781,7 +759,7 @@ SUBROUTINE WD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL WD_Unpackinputfiletype( Re_Buf, Db_Buf, Int_Buf, OutData%InputFileData, ErrStat2, ErrMsg2 ) ! InputFileData + CALL WD_UnpackInputFileType( Re_Buf, Db_Buf, Int_Buf, OutData%InputFileData, ErrStat2, ErrMsg2 ) ! InputFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -840,14 +818,12 @@ SUBROUTINE WD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE WD_CopyInitOutput - SUBROUTINE WD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) TYPE(WD_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInitOutput' @@ -855,19 +831,13 @@ SUBROUTINE WD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN DEALLOCATE(InitOutputData%WriteOutputHdr) ENDIF IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN DEALLOCATE(InitOutputData%WriteOutputUnt) ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WD_DestroyInitOutput @@ -918,7 +888,7 @@ SUBROUTINE WD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -995,7 +965,7 @@ SUBROUTINE WD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END DO ! I END DO END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1125,7 +1095,7 @@ SUBROUTINE WD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1151,14 +1121,12 @@ SUBROUTINE WD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrSt DstContStateData%DummyContState = SrcContStateData%DummyContState END SUBROUTINE WD_CopyContState - SUBROUTINE WD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WD_DestroyContState( ContStateData, ErrStat, ErrMsg ) TYPE(WD_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyContState' @@ -1166,12 +1134,6 @@ SUBROUTINE WD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE WD_DestroyContState SUBROUTINE WD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1495,14 +1457,12 @@ SUBROUTINE WD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt ENDIF END SUBROUTINE WD_CopyDiscState - SUBROUTINE WD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) TYPE(WD_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyDiscState' @@ -1510,12 +1470,6 @@ SUBROUTINE WD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(DiscStateData%xhat_plane)) THEN DEALLOCATE(DiscStateData%xhat_plane) ENDIF @@ -2370,14 +2324,12 @@ SUBROUTINE WD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState END SUBROUTINE WD_CopyConstrState - SUBROUTINE WD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) TYPE(WD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyConstrState' @@ -2385,12 +2337,6 @@ SUBROUTINE WD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpo ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE WD_DestroyConstrState SUBROUTINE WD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2507,14 +2453,12 @@ SUBROUTINE WD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%firstPass = SrcOtherStateData%firstPass END SUBROUTINE WD_CopyOtherState - SUBROUTINE WD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) TYPE(WD_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyOtherState' @@ -2522,12 +2466,6 @@ SUBROUTINE WD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpoin ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE WD_DestroyOtherState SUBROUTINE WD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2934,14 +2872,12 @@ SUBROUTINE WD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%Ct_avg = SrcMiscData%Ct_avg END SUBROUTINE WD_CopyMisc - SUBROUTINE WD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WD_DestroyMisc( MiscData, ErrStat, ErrMsg ) TYPE(WD_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyMisc' @@ -2949,12 +2885,6 @@ SUBROUTINE WD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MiscData%dvtdr)) THEN DEALLOCATE(MiscData%dvtdr) ENDIF @@ -4183,14 +4113,12 @@ SUBROUTINE WD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%WAT_k_Grad = SrcParamData%WAT_k_Grad END SUBROUTINE WD_CopyParam - SUBROUTINE WD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WD_DestroyParam( ParamData, ErrStat, ErrMsg ) TYPE(WD_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyParam' @@ -4198,12 +4126,6 @@ SUBROUTINE WD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(ParamData%r)) THEN DEALLOCATE(ParamData%r) ENDIF @@ -4680,14 +4602,12 @@ SUBROUTINE WD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) ENDIF END SUBROUTINE WD_CopyInput - SUBROUTINE WD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WD_DestroyInput( InputData, ErrStat, ErrMsg ) TYPE(WD_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInput' @@ -4695,12 +4615,6 @@ SUBROUTINE WD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(InputData%V_plane)) THEN DEALLOCATE(InputData%V_plane) ENDIF @@ -5150,14 +5064,12 @@ SUBROUTINE WD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs ENDIF END SUBROUTINE WD_CopyOutput - SUBROUTINE WD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE WD_DestroyOutput( OutputData, ErrStat, ErrMsg ) TYPE(WD_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyOutput' @@ -5165,12 +5077,6 @@ SUBROUTINE WD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(OutputData%xhat_plane)) THEN DEALLOCATE(OutputData%xhat_plane) ENDIF diff --git a/vs-build/Registry/FAST_Registry.vcxproj b/vs-build/Registry/FAST_Registry.vcxproj index 90fb08b2c6..fbc6bded9a 100644 --- a/vs-build/Registry/FAST_Registry.vcxproj +++ b/vs-build/Registry/FAST_Registry.vcxproj @@ -155,23 +155,15 @@ - - - - - - - - - - + + + + + - - - - - + + From 9b6bd5b02de0dc3000ee00dd3136968836bf8e82 Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Fri, 26 May 2023 16:02:40 -0600 Subject: [PATCH 04/12] Move wave data into WaveField and switch to using pointers to WaveField instead of copying WaveField --- modules/hydrodyn/src/HydroDyn.f90 | 3 +- modules/hydrodyn/src/HydroDyn.txt | 2 +- modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 3 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 95 +- modules/hydrodyn/src/Morison.txt | 2 +- modules/hydrodyn/src/Morison_Types.f90 | 95 +- modules/openfast-library/src/FAST_Subs.f90 | 6 +- modules/seastate/src/SeaSt_WaveField.f90 | 36 +- modules/seastate/src/SeaSt_WaveField.txt | 31 +- .../seastate/src/SeaSt_WaveField_Types.f90 | 1118 ++++++++++++++++- modules/seastate/src/SeaState.f90 | 101 +- modules/seastate/src/SeaState.txt | 4 +- modules/seastate/src/SeaState_Types.f90 | 138 +- modules/seastate/src/UserWaves.f90 | 101 +- modules/seastate/src/Waves.f90 | 331 ++--- 15 files changed, 1439 insertions(+), 627 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 4a1e16a772..acf680ac87 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -608,7 +608,8 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I InputFileData%Morison%WaveStMod = InitInp%WaveStMod - CALL SeaSt_WaveField_CopySeaSt_WaveFieldType( InitInp%WaveField, InputFileData%Morison%WaveField, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + ! CALL SeaSt_WaveField_CopySeaSt_WaveFieldType( InitInp%WaveField, InputFileData%Morison%WaveField, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + InputFileData%Morison%WaveField => InitInp%WaveField ! If we did some second order wave kinematics corrections to the acceleration, velocity or ! dynamic pressure using the Waves2 module, then we need to add these to the values that we diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index fe641628c5..22fcf887e1 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -122,7 +122,7 @@ typedef ^ ^ LOGICAL WaveMultiDi typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - typedef ^ ^ SiKi MCFD - - - "Diameter of MacCamy-Fuchs members" (meters) -typedef ^ ^ SeaSt_WaveFieldType WaveField - - - "SeaState wave field" - +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - # # # Define outputs from the initialization routine here: diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index ec1e8b50a5..3071449298 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -368,7 +368,8 @@ subroutine SetHD_InitInputs() CALL SeaSt_Interp_CopyParam(InitOutData_SeaSt%SeaSt_Interp_p, InitInData_HD%SeaSt_Interp_p, MESH_NEWCOPY, ErrStat, ErrMsg ); CALL CheckError() - CALL SeaSt_WaveField_CopySeaSt_WaveFieldType( InitOutData_SeaSt%WaveField, InitInData_HD%WaveField, MESH_NEWCOPY, ErrStat, ErrMsg ) + ! CALL SeaSt_WaveField_CopySeaSt_WaveFieldType( InitOutData_SeaSt%WaveField, InitInData_HD%WaveField, MESH_NEWCOPY, ErrStat, ErrMsg ) + InitInData_HD%WaveField => InitOutData_SeaSt%WaveField end subroutine SetHD_InitInputs !---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index e8cf17e310..a5a140192f 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -130,7 +130,7 @@ MODULE HydroDyn_Types REAL(SiKi) :: WaveDOmega !< Frequency step for incident wave calculations [(rad/s)] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] REAL(SiKi) :: MCFD !< Diameter of MacCamy-Fuchs members [(meters)] - TYPE(SeaSt_WaveFieldType) :: WaveField !< SeaState wave field [-] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE HydroDyn_InitInputType ! ======================= ! ========= HydroDyn_InitOutputType ======= @@ -1829,9 +1829,7 @@ SUBROUTINE HydroDyn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN DstInitInputData%MCFD = SrcInitInputData%MCFD - CALL SeaSt_WaveField_Copyseast_wavefieldtype( SrcInitInputData%WaveField, DstInitInputData%WaveField, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN + DstInitInputData%WaveField => SrcInitInputData%WaveField END SUBROUTINE HydroDyn_CopyInitInput SUBROUTINE HydroDyn_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) @@ -1870,8 +1868,7 @@ SUBROUTINE HydroDyn_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) NULLIFY(InitInputData%WaveDirArr) CALL SeaSt_Interp_DestroyParam( InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_WaveField_DestroySeaSt_WaveFieldType( InitInputData%WaveField, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +NULLIFY(InitInputData%WaveField) END SUBROUTINE HydroDyn_DestroyInitInput SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1984,23 +1981,6 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Re_BufSz = Re_BufSz + 1 ! MCFD - Int_BufSz = Int_BufSz + 3 ! WaveField: size of buffers for each call to pack subtype - CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WaveField - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WaveField - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WaveField - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -2188,34 +2168,6 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF ReKiBuf(Re_Xferred) = InData%MCFD Re_Xferred = Re_Xferred + 1 - CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF END SUBROUTINE HydroDyn_PackInitInput SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2452,46 +2404,7 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) OutData%MCFD = REAL(ReKiBuf(Re_Xferred), SiKi) Re_Xferred = Re_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_WaveField_UnpackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + NULLIFY(OutData%WaveField) END SUBROUTINE HydroDyn_UnPackInitInput SUBROUTINE HydroDyn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index 01d0584aa0..d088280123 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -287,7 +287,7 @@ typedef ^ ^ SiKi typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - typedef ^ ^ INTEGER WaveStMod - - - "" - typedef ^ ^ SiKi MCFD - - - "Diameter of the MacCamy-Fuchs member." - -typedef ^ ^ SeaSt_WaveFieldType WaveField - - - "SeaState wave field" - +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - # # # Define outputs from the initialization routine here: diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 9a8f65bb4f..153bc8df5e 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -350,7 +350,7 @@ MODULE Morison_Types TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] INTEGER(IntKi) :: WaveStMod !< [-] REAL(SiKi) :: MCFD !< Diameter of the MacCamy-Fuchs member. [-] - TYPE(SeaSt_WaveFieldType) :: WaveField !< SeaState wave field [-] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE Morison_InitInputType ! ======================= ! ========= Morison_InitOutputType ======= @@ -6493,9 +6493,7 @@ SUBROUTINE Morison_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, IF (ErrStat>=AbortErrLev) RETURN DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod DstInitInputData%MCFD = SrcInitInputData%MCFD - CALL SeaSt_WaveField_Copyseast_wavefieldtype( SrcInitInputData%WaveField, DstInitInputData%WaveField, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN + DstInitInputData%WaveField => SrcInitInputData%WaveField END SUBROUTINE Morison_CopyInitInput SUBROUTINE Morison_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) @@ -6604,8 +6602,7 @@ SUBROUTINE Morison_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) NULLIFY(InitInputData%PWaveVel0) CALL SeaSt_Interp_DestroyParam( InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_WaveField_DestroySeaSt_WaveFieldType( InitInputData%WaveField, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +NULLIFY(InitInputData%WaveField) END SUBROUTINE Morison_DestroyInitInput SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -6958,23 +6955,6 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END IF Int_BufSz = Int_BufSz + 1 ! WaveStMod Re_BufSz = Re_BufSz + 1 ! MCFD - Int_BufSz = Int_BufSz + 3 ! WaveField: size of buffers for each call to pack subtype - CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WaveField - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WaveField - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WaveField - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -7576,34 +7556,6 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 1 ReKiBuf(Re_Xferred) = InData%MCFD Re_Xferred = Re_Xferred + 1 - CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF END SUBROUTINE Morison_PackInitInput SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -8402,46 +8354,7 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Xferred = Int_Xferred + 1 OutData%MCFD = REAL(ReKiBuf(Re_Xferred), SiKi) Re_Xferred = Re_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_WaveField_UnpackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + NULLIFY(OutData%WaveField) END SUBROUTINE Morison_UnPackInitInput SUBROUTINE Morison_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index d9df73fdce..739b2b5012 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -845,8 +845,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, call SeaSt_Interp_CopyParam(Init%OutData_SeaSt%SeaSt_Interp_p, Init%InData_HD%SeaSt_Interp_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SeaSt_WaveField_CopySeaSt_WaveFieldType( Init%OutData_SeaSt%WaveField, Init%InData_HD%WaveField, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! call SeaSt_WaveField_CopySeaSt_WaveFieldType( Init%OutData_SeaSt%WaveField, Init%InData_HD%WaveField, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + ! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Init%InData_HD%WaveField => Init%OutData_SeaSt%WaveField + end if diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index 6d2f60f26e..4aea57f6bc 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -35,7 +35,7 @@ FUNCTION WaveField_GetWaveElev1( WaveField, Time, pos, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" - IF (associated(WaveField%WaveElev1)) THEN + IF (ALLOCATED(WaveField%WaveElev1)) THEN Zeta = SeaSt_Interp_3D( Time, pos(1:2), WaveField%WaveElev1, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE @@ -63,7 +63,7 @@ FUNCTION WaveField_GetWaveElev2( WaveField, Time, pos, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" - IF (associated(WaveField%WaveElev2)) THEN + IF (ALLOCATED(WaveField%WaveElev2)) THEN Zeta = SeaSt_Interp_3D( Time, pos(1:2), WaveField%WaveElev2, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE @@ -186,7 +186,7 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, Time, posIn, nodeInWater, WaveElev1, 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 ) - IF ( ASSOCIATED(WaveField%WaveAccMCF) ) THEN + IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, seast_interp_m, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -217,7 +217,7 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, Time, posIn, nodeInWater, WaveElev1, 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 ) - IF ( ASSOCIATED(WaveField%WaveAccMCF) ) THEN + IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, seast_interp_m, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -233,7 +233,7 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, Time, posIn, nodeInWater, WaveElev1, 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 ) - IF ( ASSOCIATED(WaveField%WaveAccMCF) ) THEN + IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN FAMCF(:) = SeaSt_Interp_4D_vec( WaveField%WaveAccMCF, seast_interp_m, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -246,7 +246,7 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, Time, posIn, nodeInWater, WaveElev1, call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FDynP = FDynP + SeaSt_Interp_3D ( Time, posXY, WaveField%PWaveDynP0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ASSOCIATED(WaveField%WaveAccMCF) ) THEN + IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN FAMCF(:) = FAMCF(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveAccMCF0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -269,7 +269,7 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, Time, posIn, nodeInWater, WaveElev1, 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 ) - IF ( ASSOCIATED(WaveField%WaveAccMCF) ) THEN + IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, seast_interp_m, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -295,17 +295,17 @@ SUBROUTINE WaveField_End( WaveField ) ! Dissociate all pointers within WaveField and let SeaState deallocate the data ! Temporary solution before the code is modified to exclusively use WaveField - NULLIFY( WaveField%WaveTime ) - NULLIFY( WaveField%WaveDynP ) - NULLIFY( WaveField%WaveAcc ) - NULLIFY( WaveField%WaveAccMCF ) - NULLIFY( WaveField%WaveVel ) - NULLIFY( WaveField%PWaveDynP0 ) - NULLIFY( WaveField%PWaveAcc0 ) - NULLIFY( WaveField%PWaveAccMCF0 ) - NULLIFY( WaveField%PWaveVel0 ) - NULLIFY( WaveField%WaveElev1 ) - NULLIFY( WaveField%WaveElev2 ) + ! NULLIFY( WaveField%WaveTime ) + ! NULLIFY( WaveField%WaveDynP ) + ! NULLIFY( WaveField%WaveAcc ) + ! NULLIFY( WaveField%WaveAccMCF ) + ! NULLIFY( WaveField%WaveVel ) + ! NULLIFY( WaveField%PWaveDynP0 ) + ! NULLIFY( WaveField%PWaveAcc0 ) + ! NULLIFY( WaveField%PWaveAccMCF0 ) + ! NULLIFY( WaveField%PWaveVel0 ) + ! NULLIFY( WaveField%WaveElev1 ) + ! NULLIFY( WaveField%WaveElev2 ) END SUBROUTINE WaveField_End diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index 00f49a4f04..32a0702405 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -1,22 +1,25 @@ -#---------------------------------------------------------------------------------------------------------------------------------- +#--------------------------------------------------------------------------------------------------------------------------------------------------------- # Data structures for representing wave fields. # usefrom SeaState_Interp.txt -#---------------------------------------------------------------------------------------------------------------------------------- +#--------------------------------------------------------------------------------------------------------------------------------------------------------- # -#---------------------------------------------------------------------------------------------------------------------------------- -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) -typedef ^ ^ SiKi WaveAccMCF {*}{*}{*}{*}{*} - - "Scaled acceleration for MacCamy-Fuchs members" (m/s^2) -typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Incident wave velocity" (m/s) -typedef ^ ^ SiKi PWaveDynP0 {*}{*}{*} - - "Partial derivative of dynamic pressure in the vertical direction at the still water level" (Pa/m) -typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "Partial derivative of incident wave acceleration in the vertical direction at the still water level" (m/s^2/m) -typedef ^ ^ SiKi PWaveAccMCF0 {*}{*}{*}{*} - - "Partial derivative of scaled wave acceleration in the vertical direction at the still water level for MacCamy-Fuchs members" (m/s^2/m) -typedef ^ ^ SiKi PWaveVel0 {*}{*}{*}{*} - - "Partial derivative of incident wave velocity in the vertical direction at the still water level" (m/s/m) -typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation" (m) -typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation" (m) +#--------------------------------------------------------------------------------------------------------------------------------------------------------- +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) +typedef ^ ^ SiKi WaveAccMCF {:}{:}{:}{:}{:} - - "Scaled acceleration for MacCamy-Fuchs members" (m/s^2) +typedef ^ ^ SiKi WaveVel {:}{:}{:}{:}{:} - - "Incident wave velocity" (m/s) +typedef ^ ^ SiKi PWaveDynP0 {:}{:}{:} - - "Partial derivative of dynamic pressure in the vertical direction at the still water level" (Pa/m) +typedef ^ ^ SiKi PWaveAcc0 {:}{:}{:}{:} - - "Partial derivative of incident wave acceleration in the vertical direction at the still water level" (m/s^2/m) +typedef ^ ^ SiKi PWaveAccMCF0 {:}{:}{:}{:} - - "Partial derivative of scaled wave acceleration in the vertical direction at the still water level for MacCamy-Fuchs members" (m/s^2/m) +typedef ^ ^ SiKi PWaveVel0 {:}{:}{:}{:} - - "Partial derivative of incident wave velocity in the vertical direction at the still water level" (m/s/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 ^ ^ IntKi WaveStMod - - - "Wave stretching model" typedef ^ ^ ReKi EffWtrDpth - - - "Water depth" (-) typedef ^ ^ ReKi MSL2SWL - - - "Vertical distance from mean sea level to still water level" (m) +typedef ^ ^ SiKi WaveElevC0 {:}{:} - - "Fourier components of the incident wave elevation at the platform reference point. First column is the real part; second column is the imaginary part" (m) +typedef ^ ^ SiKi WaveDirArr {:} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) + diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 4059ea861a..79e57025c3 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -36,21 +36,23 @@ MODULE SeaSt_WaveField_Types IMPLICIT NONE ! ========= SeaSt_WaveFieldType ======= TYPE, PUBLIC :: SeaSt_WaveFieldType - REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Time array [(s)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: WaveDynP => NULL() !< Incident wave dynamic pressure [(N/m^2)] - REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Incident wave acceleration [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAccMCF => NULL() !< Scaled acceleration for MacCamy-Fuchs members [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Incident wave velocity [(m/s)] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: PWaveDynP0 => NULL() !< Partial derivative of dynamic pressure in the vertical direction at the still water level [(Pa/m)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< Partial derivative of incident wave acceleration in the vertical direction at the still water level [(m/s^2/m)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAccMCF0 => NULL() !< Partial derivative of scaled wave acceleration in the vertical direction at the still water level for MacCamy-Fuchs members [(m/s^2/m)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveVel0 => NULL() !< Partial derivative of incident wave velocity in the vertical direction at the still water level [(m/s/m)] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation [(m)] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation [(m)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Time array [(s)] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WaveDynP !< Incident wave dynamic pressure [(N/m^2)] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveAcc !< Incident wave acceleration [(m/s^2)] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveAccMCF !< Scaled acceleration for MacCamy-Fuchs members [(m/s^2)] + REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveVel !< Incident wave velocity [(m/s)] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: PWaveDynP0 !< Partial derivative of dynamic pressure in the vertical direction at the still water level [(Pa/m)] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: PWaveAcc0 !< Partial derivative of incident wave acceleration in the vertical direction at the still water level [(m/s^2/m)] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: PWaveAccMCF0 !< Partial derivative of scaled wave acceleration in the vertical direction at the still water level for MacCamy-Fuchs members [(m/s^2/m)] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: PWaveVel0 !< Partial derivative of incident wave velocity in the vertical direction at the still water level [(m/s/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 [(-)] INTEGER(IntKi) :: WaveStMod !< Wave stretching model [-] REAL(ReKi) :: EffWtrDpth !< Water depth [(-)] REAL(ReKi) :: MSL2SWL !< Vertical distance from mean sea level to still water level [(m)] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevC0 !< Fourier components of the incident wave elevation at the platform reference point. First column is the real part; second column is the imaginary part [(m)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveDirArr !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] END TYPE SeaSt_WaveFieldType ! ======================= CONTAINS @@ -73,23 +75,230 @@ SUBROUTINE SeaSt_WaveField_CopySeaSt_WaveFieldType( SrcSeaSt_WaveFieldTypeData, ! ErrStat = ErrID_None ErrMsg = "" - DstSeaSt_WaveFieldTypeData%WaveTime => SrcSeaSt_WaveFieldTypeData%WaveTime - DstSeaSt_WaveFieldTypeData%WaveDynP => SrcSeaSt_WaveFieldTypeData%WaveDynP - DstSeaSt_WaveFieldTypeData%WaveAcc => SrcSeaSt_WaveFieldTypeData%WaveAcc - DstSeaSt_WaveFieldTypeData%WaveAccMCF => SrcSeaSt_WaveFieldTypeData%WaveAccMCF - DstSeaSt_WaveFieldTypeData%WaveVel => SrcSeaSt_WaveFieldTypeData%WaveVel - DstSeaSt_WaveFieldTypeData%PWaveDynP0 => SrcSeaSt_WaveFieldTypeData%PWaveDynP0 - DstSeaSt_WaveFieldTypeData%PWaveAcc0 => SrcSeaSt_WaveFieldTypeData%PWaveAcc0 - DstSeaSt_WaveFieldTypeData%PWaveAccMCF0 => SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0 - DstSeaSt_WaveFieldTypeData%PWaveVel0 => SrcSeaSt_WaveFieldTypeData%PWaveVel0 - DstSeaSt_WaveFieldTypeData%WaveElev1 => SrcSeaSt_WaveFieldTypeData%WaveElev1 - DstSeaSt_WaveFieldTypeData%WaveElev2 => SrcSeaSt_WaveFieldTypeData%WaveElev2 +IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveTime)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveTime,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveTime,1) + IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveTime)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveTime(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveTime.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%WaveTime = SrcSeaSt_WaveFieldTypeData%WaveTime +ENDIF +IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveDynP)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,3) + i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,4) + i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,4) + IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveDynP)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveDynP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%WaveDynP = SrcSeaSt_WaveFieldTypeData%WaveDynP +ENDIF +IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveAcc)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,3) + i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,4) + i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,4) + i5_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,5) + i5_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,5) + IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveAcc)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveAcc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%WaveAcc = SrcSeaSt_WaveFieldTypeData%WaveAcc +ENDIF +IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveAccMCF)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,3) + i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,4) + i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,4) + i5_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,5) + i5_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,5) + IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveAccMCF)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%WaveAccMCF = SrcSeaSt_WaveFieldTypeData%WaveAccMCF +ENDIF +IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveVel)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,3) + i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,4) + i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,4) + i5_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,5) + i5_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,5) + IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveVel)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveVel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%WaveVel = SrcSeaSt_WaveFieldTypeData%WaveVel +ENDIF +IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%PWaveDynP0)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,3) + IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%PWaveDynP0)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%PWaveDynP0 = SrcSeaSt_WaveFieldTypeData%PWaveDynP0 +ENDIF +IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%PWaveAcc0)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,3) + i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,4) + i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,4) + IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%PWaveAcc0)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%PWaveAcc0 = SrcSeaSt_WaveFieldTypeData%PWaveAcc0 +ENDIF +IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,3) + i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,4) + i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,4) + IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%PWaveAccMCF0 = SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0 +ENDIF +IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%PWaveVel0)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,3) + i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,4) + i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,4) + IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%PWaveVel0)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%PWaveVel0 = SrcSeaSt_WaveFieldTypeData%PWaveVel0 +ENDIF +IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveElev1)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,3) + IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveElev1)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElev1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%WaveElev1 = SrcSeaSt_WaveFieldTypeData%WaveElev1 +ENDIF +IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveElev2)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,3) + IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveElev2)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElev2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%WaveElev2 = SrcSeaSt_WaveFieldTypeData%WaveElev2 +ENDIF CALL SeaSt_Interp_CopyParam( SrcSeaSt_WaveFieldTypeData%SeaSt_Interp_p, DstSeaSt_WaveFieldTypeData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN DstSeaSt_WaveFieldTypeData%WaveStMod = SrcSeaSt_WaveFieldTypeData%WaveStMod DstSeaSt_WaveFieldTypeData%EffWtrDpth = SrcSeaSt_WaveFieldTypeData%EffWtrDpth DstSeaSt_WaveFieldTypeData%MSL2SWL = SrcSeaSt_WaveFieldTypeData%MSL2SWL +IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveElevC0)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC0,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC0,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC0,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC0,2) + IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveElevC0)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%WaveElevC0 = SrcSeaSt_WaveFieldTypeData%WaveElevC0 +ENDIF +IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveDirArr)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveDirArr,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveDirArr,1) + IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveDirArr)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%WaveDirArr = SrcSeaSt_WaveFieldTypeData%WaveDirArr +ENDIF END SUBROUTINE SeaSt_WaveField_CopySeaSt_WaveFieldType SUBROUTINE SeaSt_WaveField_DestroySeaSt_WaveFieldType( SeaSt_WaveFieldTypeData, ErrStat, ErrMsg ) @@ -105,19 +314,47 @@ SUBROUTINE SeaSt_WaveField_DestroySeaSt_WaveFieldType( SeaSt_WaveFieldTypeData, ErrStat = ErrID_None ErrMsg = "" -NULLIFY(SeaSt_WaveFieldTypeData%WaveTime) -NULLIFY(SeaSt_WaveFieldTypeData%WaveDynP) -NULLIFY(SeaSt_WaveFieldTypeData%WaveAcc) -NULLIFY(SeaSt_WaveFieldTypeData%WaveAccMCF) -NULLIFY(SeaSt_WaveFieldTypeData%WaveVel) -NULLIFY(SeaSt_WaveFieldTypeData%PWaveDynP0) -NULLIFY(SeaSt_WaveFieldTypeData%PWaveAcc0) -NULLIFY(SeaSt_WaveFieldTypeData%PWaveAccMCF0) -NULLIFY(SeaSt_WaveFieldTypeData%PWaveVel0) -NULLIFY(SeaSt_WaveFieldTypeData%WaveElev1) -NULLIFY(SeaSt_WaveFieldTypeData%WaveElev2) +IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveTime)) THEN + DEALLOCATE(SeaSt_WaveFieldTypeData%WaveTime) +ENDIF +IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveDynP)) THEN + DEALLOCATE(SeaSt_WaveFieldTypeData%WaveDynP) +ENDIF +IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveAcc)) THEN + DEALLOCATE(SeaSt_WaveFieldTypeData%WaveAcc) +ENDIF +IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveAccMCF)) THEN + DEALLOCATE(SeaSt_WaveFieldTypeData%WaveAccMCF) +ENDIF +IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveVel)) THEN + DEALLOCATE(SeaSt_WaveFieldTypeData%WaveVel) +ENDIF +IF (ALLOCATED(SeaSt_WaveFieldTypeData%PWaveDynP0)) THEN + DEALLOCATE(SeaSt_WaveFieldTypeData%PWaveDynP0) +ENDIF +IF (ALLOCATED(SeaSt_WaveFieldTypeData%PWaveAcc0)) THEN + DEALLOCATE(SeaSt_WaveFieldTypeData%PWaveAcc0) +ENDIF +IF (ALLOCATED(SeaSt_WaveFieldTypeData%PWaveAccMCF0)) THEN + DEALLOCATE(SeaSt_WaveFieldTypeData%PWaveAccMCF0) +ENDIF +IF (ALLOCATED(SeaSt_WaveFieldTypeData%PWaveVel0)) THEN + DEALLOCATE(SeaSt_WaveFieldTypeData%PWaveVel0) +ENDIF +IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveElev1)) THEN + DEALLOCATE(SeaSt_WaveFieldTypeData%WaveElev1) +ENDIF +IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveElev2)) THEN + DEALLOCATE(SeaSt_WaveFieldTypeData%WaveElev2) +ENDIF CALL SeaSt_Interp_DestroyParam( SeaSt_WaveFieldTypeData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveElevC0)) THEN + DEALLOCATE(SeaSt_WaveFieldTypeData%WaveElevC0) +ENDIF +IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveDirArr)) THEN + DEALLOCATE(SeaSt_WaveFieldTypeData%WaveDirArr) +ENDIF END SUBROUTINE SeaSt_WaveField_DestroySeaSt_WaveFieldType SUBROUTINE SeaSt_WaveField_PackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -155,6 +392,61 @@ SUBROUTINE SeaSt_WaveField_PackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no + IF ( ALLOCATED(InData%WaveTime) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime + END IF + Int_BufSz = Int_BufSz + 1 ! WaveDynP allocated yes/no + IF ( ALLOCATED(InData%WaveDynP) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! WaveDynP upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP) ! WaveDynP + END IF + Int_BufSz = Int_BufSz + 1 ! WaveAcc allocated yes/no + IF ( ALLOCATED(InData%WaveAcc) ) THEN + Int_BufSz = Int_BufSz + 2*5 ! WaveAcc upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc) ! WaveAcc + END IF + Int_BufSz = Int_BufSz + 1 ! WaveAccMCF allocated yes/no + IF ( ALLOCATED(InData%WaveAccMCF) ) THEN + Int_BufSz = Int_BufSz + 2*5 ! WaveAccMCF upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveAccMCF) ! WaveAccMCF + END IF + Int_BufSz = Int_BufSz + 1 ! WaveVel allocated yes/no + IF ( ALLOCATED(InData%WaveVel) ) THEN + Int_BufSz = Int_BufSz + 2*5 ! WaveVel upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveVel) ! WaveVel + END IF + Int_BufSz = Int_BufSz + 1 ! PWaveDynP0 allocated yes/no + IF ( ALLOCATED(InData%PWaveDynP0) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! PWaveDynP0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PWaveDynP0) ! PWaveDynP0 + END IF + Int_BufSz = Int_BufSz + 1 ! PWaveAcc0 allocated yes/no + IF ( ALLOCATED(InData%PWaveAcc0) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! PWaveAcc0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PWaveAcc0) ! PWaveAcc0 + END IF + Int_BufSz = Int_BufSz + 1 ! PWaveAccMCF0 allocated yes/no + IF ( ALLOCATED(InData%PWaveAccMCF0) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! PWaveAccMCF0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PWaveAccMCF0) ! PWaveAccMCF0 + END IF + Int_BufSz = Int_BufSz + 1 ! PWaveVel0 allocated yes/no + IF ( ALLOCATED(InData%PWaveVel0) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! PWaveVel0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PWaveVel0) ! PWaveVel0 + END IF + Int_BufSz = Int_BufSz + 1 ! WaveElev1 allocated yes/no + IF ( ALLOCATED(InData%WaveElev1) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! WaveElev1 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElev1) ! WaveElev1 + END IF + Int_BufSz = Int_BufSz + 1 ! WaveElev2 allocated yes/no + IF ( ALLOCATED(InData%WaveElev2) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! WaveElev2 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElev2) ! WaveElev2 + END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_p: size of buffers for each call to pack subtype CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt_Interp_p @@ -176,6 +468,16 @@ SUBROUTINE SeaSt_WaveField_PackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Int_BufSz = Int_BufSz + 1 ! WaveStMod Re_BufSz = Re_BufSz + 1 ! EffWtrDpth Re_BufSz = Re_BufSz + 1 ! MSL2SWL + Int_BufSz = Int_BufSz + 1 ! WaveElevC0 allocated yes/no + IF ( ALLOCATED(InData%WaveElevC0) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WaveElevC0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC0) ! WaveElevC0 + END IF + Int_BufSz = Int_BufSz + 1 ! WaveDirArr allocated yes/no + IF ( ALLOCATED(InData%WaveDirArr) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveDirArr upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveDirArr) ! WaveDirArr + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -203,6 +505,321 @@ SUBROUTINE SeaSt_WaveField_PackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Db_Xferred = 1 Int_Xferred = 1 + IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveDynP) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%WaveDynP,4), UBOUND(InData%WaveDynP,4) + DO i3 = LBOUND(InData%WaveDynP,3), UBOUND(InData%WaveDynP,3) + DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) + DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveAcc) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,4) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,5) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,5) + Int_Xferred = Int_Xferred + 2 + + DO i5 = LBOUND(InData%WaveAcc,5), UBOUND(InData%WaveAcc,5) + DO i4 = LBOUND(InData%WaveAcc,4), UBOUND(InData%WaveAcc,4) + DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) + DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) + DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3,i4,i5) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveAccMCF) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,4) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,5) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,5) + Int_Xferred = Int_Xferred + 2 + + DO i5 = LBOUND(InData%WaveAccMCF,5), UBOUND(InData%WaveAccMCF,5) + DO i4 = LBOUND(InData%WaveAccMCF,4), UBOUND(InData%WaveAccMCF,4) + DO i3 = LBOUND(InData%WaveAccMCF,3), UBOUND(InData%WaveAccMCF,3) + DO i2 = LBOUND(InData%WaveAccMCF,2), UBOUND(InData%WaveAccMCF,2) + DO i1 = LBOUND(InData%WaveAccMCF,1), UBOUND(InData%WaveAccMCF,1) + ReKiBuf(Re_Xferred) = InData%WaveAccMCF(i1,i2,i3,i4,i5) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,4) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,5) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,5) + Int_Xferred = Int_Xferred + 2 + + DO i5 = LBOUND(InData%WaveVel,5), UBOUND(InData%WaveVel,5) + DO i4 = LBOUND(InData%WaveVel,4), UBOUND(InData%WaveVel,4) + DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) + DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) + DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) + ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3,i4,i5) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PWaveDynP0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%PWaveDynP0,3), UBOUND(InData%PWaveDynP0,3) + DO i2 = LBOUND(InData%PWaveDynP0,2), UBOUND(InData%PWaveDynP0,2) + DO i1 = LBOUND(InData%PWaveDynP0,1), UBOUND(InData%PWaveDynP0,1) + ReKiBuf(Re_Xferred) = InData%PWaveDynP0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PWaveAcc0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%PWaveAcc0,4), UBOUND(InData%PWaveAcc0,4) + DO i3 = LBOUND(InData%PWaveAcc0,3), UBOUND(InData%PWaveAcc0,3) + DO i2 = LBOUND(InData%PWaveAcc0,2), UBOUND(InData%PWaveAcc0,2) + DO i1 = LBOUND(InData%PWaveAcc0,1), UBOUND(InData%PWaveAcc0,1) + ReKiBuf(Re_Xferred) = InData%PWaveAcc0(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PWaveAccMCF0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%PWaveAccMCF0,4), UBOUND(InData%PWaveAccMCF0,4) + DO i3 = LBOUND(InData%PWaveAccMCF0,3), UBOUND(InData%PWaveAccMCF0,3) + DO i2 = LBOUND(InData%PWaveAccMCF0,2), UBOUND(InData%PWaveAccMCF0,2) + DO i1 = LBOUND(InData%PWaveAccMCF0,1), UBOUND(InData%PWaveAccMCF0,1) + ReKiBuf(Re_Xferred) = InData%PWaveAccMCF0(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PWaveVel0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%PWaveVel0,4), UBOUND(InData%PWaveVel0,4) + DO i3 = LBOUND(InData%PWaveVel0,3), UBOUND(InData%PWaveVel0,3) + DO i2 = LBOUND(InData%PWaveVel0,2), UBOUND(InData%PWaveVel0,2) + DO i1 = LBOUND(InData%PWaveVel0,1), UBOUND(InData%PWaveVel0,1) + ReKiBuf(Re_Xferred) = InData%PWaveVel0(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveElev1) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%WaveElev1,3), UBOUND(InData%WaveElev1,3) + DO i2 = LBOUND(InData%WaveElev1,2), UBOUND(InData%WaveElev1,2) + DO i1 = LBOUND(InData%WaveElev1,1), UBOUND(InData%WaveElev1,1) + ReKiBuf(Re_Xferred) = InData%WaveElev1(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveElev2) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%WaveElev2,3), UBOUND(InData%WaveElev2,3) + DO i2 = LBOUND(InData%WaveElev2,2), UBOUND(InData%WaveElev2,2) + DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) + ReKiBuf(Re_Xferred) = InData%WaveElev2(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -237,6 +854,41 @@ SUBROUTINE SeaSt_WaveField_PackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%MSL2SWL Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%WaveElevC0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) + DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) + ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDirArr,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) + ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF END SUBROUTINE SeaSt_WaveField_PackSeaSt_WaveFieldType SUBROUTINE SeaSt_WaveField_UnPackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -270,17 +922,354 @@ SUBROUTINE SeaSt_WaveField_UnPackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - NULLIFY(OutData%WaveTime) - NULLIFY(OutData%WaveDynP) - NULLIFY(OutData%WaveAcc) - NULLIFY(OutData%WaveAccMCF) - NULLIFY(OutData%WaveVel) - NULLIFY(OutData%PWaveDynP0) - NULLIFY(OutData%PWaveAcc0) - NULLIFY(OutData%PWaveAccMCF0) - NULLIFY(OutData%PWaveVel0) - NULLIFY(OutData%WaveElev1) - NULLIFY(OutData%WaveElev2) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) + ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveDynP)) DEALLOCATE(OutData%WaveDynP) + ALLOCATE(OutData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%WaveDynP,4), UBOUND(OutData%WaveDynP,4) + DO i3 = LBOUND(OutData%WaveDynP,3), UBOUND(OutData%WaveDynP,3) + DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) + DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) + OutData%WaveDynP(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i5_l = IntKiBuf( Int_Xferred ) + i5_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveAcc)) DEALLOCATE(OutData%WaveAcc) + ALLOCATE(OutData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i5 = LBOUND(OutData%WaveAcc,5), UBOUND(OutData%WaveAcc,5) + DO i4 = LBOUND(OutData%WaveAcc,4), UBOUND(OutData%WaveAcc,4) + DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) + DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) + DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) + OutData%WaveAcc(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAccMCF not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i5_l = IntKiBuf( Int_Xferred ) + i5_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveAccMCF)) DEALLOCATE(OutData%WaveAccMCF) + ALLOCATE(OutData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i5 = LBOUND(OutData%WaveAccMCF,5), UBOUND(OutData%WaveAccMCF,5) + DO i4 = LBOUND(OutData%WaveAccMCF,4), UBOUND(OutData%WaveAccMCF,4) + DO i3 = LBOUND(OutData%WaveAccMCF,3), UBOUND(OutData%WaveAccMCF,3) + DO i2 = LBOUND(OutData%WaveAccMCF,2), UBOUND(OutData%WaveAccMCF,2) + DO i1 = LBOUND(OutData%WaveAccMCF,1), UBOUND(OutData%WaveAccMCF,1) + OutData%WaveAccMCF(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i5_l = IntKiBuf( Int_Xferred ) + i5_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveVel)) DEALLOCATE(OutData%WaveVel) + ALLOCATE(OutData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i5 = LBOUND(OutData%WaveVel,5), UBOUND(OutData%WaveVel,5) + DO i4 = LBOUND(OutData%WaveVel,4), UBOUND(OutData%WaveVel,4) + DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) + DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) + DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) + OutData%WaveVel(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveDynP0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PWaveDynP0)) DEALLOCATE(OutData%PWaveDynP0) + ALLOCATE(OutData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%PWaveDynP0,3), UBOUND(OutData%PWaveDynP0,3) + DO i2 = LBOUND(OutData%PWaveDynP0,2), UBOUND(OutData%PWaveDynP0,2) + DO i1 = LBOUND(OutData%PWaveDynP0,1), UBOUND(OutData%PWaveDynP0,1) + OutData%PWaveDynP0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAcc0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PWaveAcc0)) DEALLOCATE(OutData%PWaveAcc0) + ALLOCATE(OutData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%PWaveAcc0,4), UBOUND(OutData%PWaveAcc0,4) + DO i3 = LBOUND(OutData%PWaveAcc0,3), UBOUND(OutData%PWaveAcc0,3) + DO i2 = LBOUND(OutData%PWaveAcc0,2), UBOUND(OutData%PWaveAcc0,2) + DO i1 = LBOUND(OutData%PWaveAcc0,1), UBOUND(OutData%PWaveAcc0,1) + OutData%PWaveAcc0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAccMCF0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PWaveAccMCF0)) DEALLOCATE(OutData%PWaveAccMCF0) + ALLOCATE(OutData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%PWaveAccMCF0,4), UBOUND(OutData%PWaveAccMCF0,4) + DO i3 = LBOUND(OutData%PWaveAccMCF0,3), UBOUND(OutData%PWaveAccMCF0,3) + DO i2 = LBOUND(OutData%PWaveAccMCF0,2), UBOUND(OutData%PWaveAccMCF0,2) + DO i1 = LBOUND(OutData%PWaveAccMCF0,1), UBOUND(OutData%PWaveAccMCF0,1) + OutData%PWaveAccMCF0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveVel0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PWaveVel0)) DEALLOCATE(OutData%PWaveVel0) + ALLOCATE(OutData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%PWaveVel0,4), UBOUND(OutData%PWaveVel0,4) + DO i3 = LBOUND(OutData%PWaveVel0,3), UBOUND(OutData%PWaveVel0,3) + DO i2 = LBOUND(OutData%PWaveVel0,2), UBOUND(OutData%PWaveVel0,2) + DO i1 = LBOUND(OutData%PWaveVel0,1), UBOUND(OutData%PWaveVel0,1) + OutData%PWaveVel0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev1 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElev1)) DEALLOCATE(OutData%WaveElev1) + ALLOCATE(OutData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%WaveElev1,3), UBOUND(OutData%WaveElev1,3) + DO i2 = LBOUND(OutData%WaveElev1,2), UBOUND(OutData%WaveElev1,2) + DO i1 = LBOUND(OutData%WaveElev1,1), UBOUND(OutData%WaveElev1,1) + OutData%WaveElev1(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev2 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElev2)) DEALLOCATE(OutData%WaveElev2) + ALLOCATE(OutData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%WaveElev2,3), UBOUND(OutData%WaveElev2,3) + DO i2 = LBOUND(OutData%WaveElev2,2), UBOUND(OutData%WaveElev2,2) + DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) + OutData%WaveElev2(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -327,6 +1316,47 @@ SUBROUTINE SeaSt_WaveField_UnPackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf Re_Xferred = Re_Xferred + 1 OutData%MSL2SWL = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElevC0)) DEALLOCATE(OutData%WaveElevC0) + ALLOCATE(OutData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) + DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) + OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveDirArr)) DEALLOCATE(OutData%WaveDirArr) + ALLOCATE(OutData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) + OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF END SUBROUTINE SeaSt_WaveField_UnPackSeaSt_WaveFieldType END MODULE SeaSt_WaveField_Types diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index a42e02f325..32629509c0 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -214,25 +214,26 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InputFileData%Waves%PtfmLocationX = InitInp%PtfmLocationX InputFileData%Waves%PtfmLocationY = InitInp%PtfmLocationY - + ! Allocate the WaveFieldType to store wave field information + ALLOCATE(p%WaveField) ! Initialize Waves module (Note that this may change InputFileData%Waves%WaveDT) - CALL Waves_Init(InputFileData%Waves, Waves_InitOut, ErrStat2, ErrMsg2 ) + 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 ! Copy Waves_InitOut pointer information before calling cleanup (to avoid memory problems): - p%WaveTime => Waves_InitOut%WaveTime - p%WaveElev1 => Waves_InitOut%WaveElev - p%WaveVel => Waves_InitOut%WaveVel - p%WaveAcc => Waves_InitOut%WaveAcc - p%WaveDynP => Waves_InitOut%WaveDynP - p%PWaveVel0 => Waves_InitOut%PWaveVel0 - p%PWaveAcc0 => Waves_InitOut%PWaveAcc0 - p%PWaveDynP0 => Waves_InitOut%PWaveDynP0 - p%WaveAccMCF => Waves_InitOut%WaveAccMCF - p%WaveElevC0 => Waves_InitOut%WaveElevC0 - p%WaveDirArr => Waves_InitOut%WaveDirArr - p%PWaveAccMCF0 => Waves_InitOut%PWaveAccMCF0 + p%WaveTime => p%WaveField%WaveTime + 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 + p%WaveAccMCF => p%WaveField%WaveAccMCF + p%WaveElevC0 => p%WaveField%WaveElevC0 + p%WaveDirArr => p%WaveField%WaveDirArr + p%PWaveAccMCF0 => p%WaveField%PWaveAccMCF0 ! check error (must be done AFTER moving pointers to parameters) IF ( ErrStat >= AbortErrLev ) THEN @@ -299,16 +300,17 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InputFileData%Waves2%WaveDirArr => Waves_InitOut%WaveDirArr CALL Waves2_Init(InputFileData%Waves2, p%Waves2, Waves2_InitOut, ErrStat2, ErrMsg2 ) - p%WaveElev2 => Waves2_InitOut%WaveElev2 ! do this before calling cleanup() so that pointers get deallocated properly - p%WaveField%WaveElev2 => Waves2_InitOut%WaveElev2 - + ALLOCATE ( p%WaveField%WaveElev2 (0:InputFileData%Waves2%NStepWave,InputFileData%Waves2%NGrid(1),InputFileData%Waves2%NGrid(2) ) , STAT=ErrStat2 ) + IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array p%WaveField%WaveElev2.', ErrStat,ErrMsg,RoutineName) + p%WaveField%WaveElev2 = Waves2_InitOut%WaveElev2 + p%WaveElev2 => p%WaveField%WaveElev2 ! do this before calling cleanup() so that pointers get deallocated properly + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() RETURN END IF - ! If we calculated wave elevations, it is now stored in p%WaveElev. So we need to add the corrections. IF (InputFileData%Waves2%NWaveElevGrid > 0 ) THEN ! Make sure the sizes of the two resulting arrays are identical... @@ -345,7 +347,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init CALL CleanUp() RETURN ELSE - p%WaveDynP = p%WaveDynP + Waves2_InitOut%WaveDynP2D + p%WaveField%WaveDynP = p%WaveField%WaveDynP + Waves2_InitOut%WaveDynP2D !IF (InputFileData%Waves%WaveStMod > 0 ) WaveDynP0 = WaveDynP0 + WaveDynP2D0 ENDIF @@ -360,7 +362,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init CALL CleanUp() RETURN ELSE - p%WaveVel = p%WaveVel + Waves2_InitOut%WaveVel2D + p%WaveField%WaveVel = p%WaveField%WaveVel + Waves2_InitOut%WaveVel2D !IF (InputFileData%Waves%WaveStMod > 0 ) WaveVel0 = WaveVel0 + WaveVel2D0 ENDIF @@ -376,7 +378,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init CALL CleanUp() RETURN ELSE - p%WaveAcc = p%WaveAcc + Waves2_InitOut%WaveAcc2D + 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 @@ -409,7 +411,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init CALL CleanUp() RETURN ELSE - p%WaveDynP = p%WaveDynP + Waves2_InitOut%WaveDynP2S + p%WaveField%WaveDynP = p%WaveField%WaveDynP + Waves2_InitOut%WaveDynP2S !IF (InputFileData%Waves%WaveStMod > 0 ) WaveDynP0 = WaveDynP0 + WaveDynP2S0 ENDIF @@ -424,7 +426,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init CALL CleanUp() RETURN ELSE - p%WaveVel = p%WaveVel + Waves2_InitOut%WaveVel2S + p%WaveField%WaveVel = p%WaveField%WaveVel + Waves2_InitOut%WaveVel2S !IF (InputFileData%Waves%WaveStMod > 0 ) WaveVel0 = WaveVel0 + WaveVel2S0 ENDIF @@ -439,7 +441,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init CALL CleanUp() RETURN ELSE - p%WaveAcc = p%WaveAcc + Waves2_InitOut%WaveAcc2S + 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 @@ -510,18 +512,18 @@ 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%WaveElev1 - InitOut%WaveDynP => p%WaveDynP ! For Morison - InitOut%WaveAcc => p%WaveAcc ! For Morison - InitOut%WaveVel => p%WaveVel ! For Morison - InitOut%PWaveDynP0 => p%PWaveDynP0 ! For Morison - InitOut%PWaveAcc0 => p%PWaveAcc0 ! For Morison - InitOut%PWaveVel0 => p%PWaveVel0 ! For Morison - InitOut%WaveAccMCF => p%WaveAccMCF ! For Morison (MacCamy-Fuchs) - InitOut%WaveTime => p%WaveTime ! For Morison, and WAMIT for use in SS_Excitation - InitOut%WaveElevC0 => p%WaveElevC0 ! For WAMIT and WAMIT2, FIT - InitOut%WaveDirArr => p%WaveDirArr ! For WAMIT and WAMIT2 - InitOut%PWaveAccMCF0 => p%PWaveAccMCF0 ! For Morison (MacCamy-Fuchs) + 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 + InitOut%PWaveAcc0 => p%WaveField%PWaveAcc0 ! For Morison + InitOut%PWaveVel0 => p%WaveField%PWaveVel0 ! For Morison + InitOut%WaveAccMCF => p%WaveField%WaveAccMCF ! For Morison (MacCamy-Fuchs) + InitOut%WaveTime => p%WaveField%WaveTime ! For Morison, and WAMIT for use in SS_Excitation + InitOut%WaveElevC0 => p%WaveField%WaveElevC0 ! For WAMIT and WAMIT2, FIT + InitOut%WaveDirArr => p%WaveField%WaveDirArr ! For WAMIT and WAMIT2 + InitOut%PWaveAccMCF0 => p%WaveField%PWaveAccMCF0 ! For Morison (MacCamy-Fuchs) ! non-pointer data: CALL MOVE_ALLOC( Waves_InitOut%WaveElevC, InitOut%WaveElevC ) ! For WAMIT @@ -555,18 +557,19 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WaveField%MSL2SWL = InitOut%MSL2SWL p%WaveField%EffWtrDpth = p%WtrDpth + InitOut%MSL2SWL ! Effective water depth measured from the SWL p%WaveField%WaveStMod = p%WaveStMod - p%WaveField%WaveTime => Waves_InitOut%WaveTime - 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 - p%WaveField%WaveAccMCF => Waves_InitOut%WaveAccMCF - p%WaveField%PWaveAccMCF0 => Waves_InitOut%PWaveAccMCF0 - - CALL SeaSt_WaveField_CopySeaSt_WaveFieldType( p%WaveField, InitOut%WaveField, MESH_NEWCOPY, ErrStat2, ErrMsg2) + ! p%WaveField%WaveTime => Waves_InitOut%WaveTime + ! 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 + ! p%WaveField%WaveAccMCF => Waves_InitOut%WaveAccMCF + ! p%WaveField%PWaveAccMCF0 => Waves_InitOut%PWaveAccMCF0 + + ! CALL SeaSt_WaveField_CopySeaSt_WaveFieldType( p%WaveField, InitOut%WaveField, MESH_NEWCOPY, ErrStat2, ErrMsg2) + InitOut%WaveField => p%WaveField ! Tell HydroDyn if state-space wave excitation is not allowed: InitOut%InvalidWithSSExctn = InputFileData%Waves%WaveMod == 6 .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 ) @@ -708,7 +711,7 @@ SUBROUTINE SeaSt_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ! Place any last minute operations or calculations here: - CALL WaveField_End(p%WaveField) + ! CALL WaveField_End(p%WaveField) ! Write the SeaState-level output file data FROM THE LAST COMPLETED TIME STEP if the user requested module-level output diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index cea3c6c7e8..c56ca1ce82 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -111,7 +111,7 @@ typedef ^ ^ LOGICAL InvalidWith typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - typedef ^ ^ SiKi MCFD - - - "Diameter of MacCamy-Fuchs member" (meters) typedef ^ ^ SiKi WaveElevSeries {:}{:} - - "Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second dimension is XY point number corresponding to second dimension of WaveElevXY." (m) -typedef ^ ^ SeaSt_WaveFieldType WaveField - - - "Wave field" +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" # # # ..... States .................................................................................................................... @@ -189,7 +189,7 @@ typedef ^ ^ CHARACTER(1) Del typedef ^ ^ INTEGER UnOutFile - - - "File unit for the SeaState outputs" - typedef ^ ^ INTEGER OutDec - - - "Write every OutDec time steps" - typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - -typedef ^ ^ SeaSt_WaveFieldType WaveField - - - "Wave field" +typedef ^ ^ SeaSt_WaveFieldType &WaveField - - - "Wave field" # # # ..... Inputs .................................................................................................................... diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 77ef809eb4..ae08aecad4 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -132,7 +132,7 @@ MODULE SeaState_Types TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] REAL(SiKi) :: MCFD !< Diameter of MacCamy-Fuchs member [(meters)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevSeries !< Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second dimension is XY point number corresponding to second dimension of WaveElevXY. [(m)] - TYPE(SeaSt_WaveFieldType) :: WaveField !< Wave field [-] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] END TYPE SeaSt_InitOutputType ! ======================= ! ========= SeaSt_ContinuousStateType ======= @@ -206,7 +206,7 @@ MODULE SeaState_Types INTEGER(IntKi) :: UnOutFile !< File unit for the SeaState outputs [-] INTEGER(IntKi) :: OutDec !< Write every OutDec time steps [-] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] - TYPE(SeaSt_WaveFieldType) :: WaveField !< Wave field [-] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Wave field [-] END TYPE SeaSt_ParameterType ! ======================= ! ========= SeaSt_InputType ======= @@ -1549,9 +1549,7 @@ SUBROUTINE SeaSt_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, END IF DstInitOutputData%WaveElevSeries = SrcInitOutputData%WaveElevSeries ENDIF - CALL SeaSt_WaveField_Copyseast_wavefieldtype( SrcInitOutputData%WaveField, DstInitOutputData%WaveField, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN + DstInitOutputData%WaveField => SrcInitOutputData%WaveField END SUBROUTINE SeaSt_CopyInitOutput SUBROUTINE SeaSt_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) @@ -1599,8 +1597,7 @@ SUBROUTINE SeaSt_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) IF (ALLOCATED(InitOutputData%WaveElevSeries)) THEN DEALLOCATE(InitOutputData%WaveElevSeries) ENDIF - CALL SeaSt_WaveField_DestroySeaSt_WaveFieldType( InitOutputData%WaveField, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +NULLIFY(InitOutputData%WaveField) END SUBROUTINE SeaSt_DestroyInitOutput SUBROUTINE SeaSt_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1720,23 +1717,6 @@ SUBROUTINE SeaSt_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_BufSz = Int_BufSz + 2*2 ! WaveElevSeries upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveElevSeries) ! WaveElevSeries END IF - Int_BufSz = Int_BufSz + 3 ! WaveField: size of buffers for each call to pack subtype - CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WaveField - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WaveField - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WaveField - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -1958,34 +1938,6 @@ SUBROUTINE SeaSt_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END DO END DO END IF - CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF END SUBROUTINE SeaSt_PackInitOutput SUBROUTINE SeaSt_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2265,46 +2217,7 @@ SUBROUTINE SeaSt_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, END DO END DO END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_WaveField_UnpackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + NULLIFY(OutData%WaveField) END SUBROUTINE SeaSt_UnPackInitOutput SUBROUTINE SeaSt_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3189,9 +3102,18 @@ SUBROUTINE SeaSt_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs CALL SeaSt_Interp_CopyParam( SrcParamData%SeaSt_Interp_p, DstParamData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN +IF (ASSOCIATED(SrcParamData%WaveField)) THEN + IF (.NOT. ASSOCIATED(DstParamData%WaveField)) THEN + ALLOCATE(DstParamData%WaveField,STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveField.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF CALL SeaSt_WaveField_Copyseast_wavefieldtype( SrcParamData%WaveField, DstParamData%WaveField, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN +ENDIF END SUBROUTINE SeaSt_CopyParam SUBROUTINE SeaSt_DestroyParam( ParamData, ErrStat, ErrMsg ) @@ -3246,8 +3168,13 @@ SUBROUTINE SeaSt_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF CALL SeaSt_Interp_DestroyParam( ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_WaveField_DestroySeaSt_WaveFieldType( ParamData%WaveField, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ASSOCIATED(ParamData%WaveField)) THEN + IF (ASSOCIATED(ParamData%WaveField)) THEN + CALL SeaSt_WaveField_DestroySeaSt_WaveFieldType( ParamData%WaveField, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ENDIF + DEALLOCATE(ParamData%WaveField) +ENDIF END SUBROUTINE SeaSt_DestroyParam SUBROUTINE SeaSt_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -3388,6 +3315,9 @@ SUBROUTINE SeaSt_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 1 ! WaveField allocated yes/no + IF ( ASSOCIATED(InData%WaveField) ) THEN + Int_BufSz = Int_BufSz + 2*0 ! WaveField upper/lower bounds for each dimension Int_BufSz = Int_BufSz + 3 ! WaveField: size of buffers for each call to pack subtype CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3405,6 +3335,7 @@ SUBROUTINE SeaSt_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -3654,6 +3585,13 @@ SUBROUTINE SeaSt_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + IF ( .NOT. ASSOCIATED(InData%WaveField) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3682,6 +3620,7 @@ SUBROUTINE SeaSt_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + END IF END SUBROUTINE SeaSt_PackParam SUBROUTINE SeaSt_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4008,6 +3947,16 @@ SUBROUTINE SeaSt_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveField not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + IF (ASSOCIATED(OutData%WaveField)) DEALLOCATE(OutData%WaveField) + ALLOCATE(OutData%WaveField,STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -4048,6 +3997,7 @@ SUBROUTINE SeaSt_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END IF END SUBROUTINE SeaSt_UnPackParam SUBROUTINE SeaSt_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) diff --git a/modules/seastate/src/UserWaves.f90 b/modules/seastate/src/UserWaves.f90 index 0088d2850d..7ec9a733b7 100644 --- a/modules/seastate/src/UserWaves.f90 +++ b/modules/seastate/src/UserWaves.f90 @@ -1,6 +1,7 @@ MODULE UserWaves USE Waves_Types + USE SeaSt_WaveField_Types USE NWTC_Library USE NWTC_FFTPACK @@ -37,8 +38,9 @@ MODULE UserWaves CONTAINS !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Initial_InitOut_Arrays(InitOut, InitInp, WaveDT, ErrStat, ErrMsg) +SUBROUTINE Initial_InitOut_Arrays(InitOut, WaveField, InitInp, WaveDT, ErrStat, ErrMsg) TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Initialization output data + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Initialization input data REAL(DbKi), INTENT(IN ) :: WaveDT ! Value of wave dt, used for filling WaveTime INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation @@ -46,7 +48,7 @@ SUBROUTINE Initial_InitOut_Arrays(InitOut, InitInp, WaveDT, ErrStat, ErrMsg) ! Local Variables INTEGER(IntKi) :: i ! loop counter INTEGER(IntKi) :: ErrStat2 ! Temporary error status -! CHARACTER(ErrMsgLen) :: ErrMsg2 + ! CHARACTER(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Initial_InitOut_Arrays' @@ -56,17 +58,16 @@ SUBROUTINE Initial_InitOut_Arrays(InitOut, InitInp, WaveDT, ErrStat, ErrMsg) ! Allocatable arrays: ALLOCATE ( InitOut%WaveElev0 ( 0:InitOut%NStepWave ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElev0.', ErrStat, ErrMsg, RoutineName) ALLOCATE ( InitOut%WaveElevC (2, 0:InitOut%NStepWave2, InitInp%NGrid(1)*InitInp%NGrid(2) ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElevC.', ErrStat,ErrMsg,RoutineName) -! ALLOCATE ( InitOut%nodeInWater( 0:InitOut%NStepWave, InitInp%NWaveKinGrid ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%nodeInWater.',ErrStat,ErrMsg,RoutineName) - ! Pointers: - ALLOCATE ( InitOut%WaveTime ( 0:InitOut%NStepWave ) , STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveTime.', ErrStat, ErrMsg, RoutineName) - ALLOCATE ( InitOut%WaveElevC0 (2, 0:InitOut%NStepWave2 ) , STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElevC0.',ErrStat, ErrMsg, RoutineName) - ALLOCATE ( InitOut%WaveDirArr ( 0:InitOut%NStepWave2 ) , STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveDirArr.',ErrStat, ErrMsg, RoutineName) + ! Allocatable arrays in WaveField: + ALLOCATE ( WaveField%WaveTime ( 0:InitOut%NStepWave ) , STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveTime.', ErrStat, ErrMsg, RoutineName) + ALLOCATE ( WaveField%WaveElevC0 (2, 0:InitOut%NStepWave2 ) , STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElevC0.',ErrStat, ErrMsg, RoutineName) + ALLOCATE ( WaveField%WaveDirArr ( 0:InitOut%NStepWave2 ) , STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveDirArr.',ErrStat, ErrMsg, RoutineName) - ALLOCATE ( InitOut%WaveElev (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElev.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( InitOut%WaveDynP (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3) ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveDynP.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( InitOut%WaveVel (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveVel.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( InitOut%WaveAcc (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveAcc.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveField%WaveElev1(0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElev1.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveField%WaveDynP (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3) ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveDynP.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveField%WaveVel (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveVel.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveField%WaveAcc (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveAcc.', ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) return @@ -79,29 +80,20 @@ SUBROUTINE Initial_InitOut_Arrays(InitOut, InitInp, WaveDT, ErrStat, ErrMsg) ! elevation of, velocity of, acceleration of, and loads associated with ! the incident waves are to be determined: DO I = 0,InitOut%NStepWave ! Loop through all time steps - InitOut%WaveTime(I) = I * WaveDT + WaveField%WaveTime(I) = I * WaveDT END DO ! I - All time steps InitOut%WaveElev0 = 0.0 InitOut%WaveElevC = 0.0 - InitOut%WaveElevC0 = 0.0 - InitOut%WaveElev = 0.0 - InitOut%WaveDynP = 0.0 - InitOut%WaveVel = 0.0 - InitOut%WaveAcc = 0.0 - InitOut%WaveDirArr = 0.0 + WaveField%WaveElevC0 = 0.0 + WaveField%WaveElev1 = 0.0 + WaveField%WaveDynP = 0.0 + WaveField%WaveVel = 0.0 + WaveField%WaveAcc = 0.0 + WaveField%WaveDirArr = 0.0 - !DO I = 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 WtrDpth have already been adjusted using MSL2SWL - ! IF ( InitInp%WaveKinGridzi(i) >= -InitInp%WtrDpth .AND. InitInp%WaveKinGridzi(i) <= 0 ) THEN - ! InitOut%nodeInWater(:, i) = 1 - ! ELSE - ! InitOut%nodeInWater(:, i) = 0 - ! END IF - !END DO - - ! scalars (adjusted later, if necessary) + ! scalars (adjusted later, if necessary) InitOut%WaveDirMin = 0.0 InitOut%WaveDirMax = 0.0 InitOut%WaveNDir = 1 @@ -277,10 +269,11 @@ END SUBROUTINE WaveElev_ReadFile !! Final timestep must match given WaveTMax in HydroDyn input file !! NOTE: Wave frequency cutoffs can are applied to the read in wave elevation time series !! -SUBROUTINE UserWaveElevations_Init ( InitInp, InitOut, ErrStat, ErrMsg ) +SUBROUTINE UserWaveElevations_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) !---------------------------------------------------------------------------------------------------------------------------------- TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine - TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut !< Initialization outputs + TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut !< Initialization outputs + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField !< Initialization outputs INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -344,7 +337,7 @@ SUBROUTINE UserWaveElevations_Init ( InitInp, InitOut, ErrStat, ErrMsg ) InitOut%WaveDOmega = TwoPi/InitInp%WaveTMax ! Compute the frequency step for incident wave calculations. ! >>> Allocate and initialize (set to 0) InitOut arrays - call Initial_InitOut_Arrays(InitOut, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) + call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @@ -391,10 +384,10 @@ SUBROUTINE UserWaveElevations_Init ( InitInp, InitOut, ErrStat, ErrMsg ) ! Copy the resulting TmpFFTWaveElev(:) data over to the InitOut%WaveElevC0 array DO I=1,InitOut%NStepWave2-1 - InitOut%WaveElevC0 (1,I) = TmpFFTWaveElev(2*I-1) - InitOut%WaveElevC0 (2,I) = TmpFFTWaveElev(2*I) + WaveField%WaveElevC0 (1,I) = TmpFFTWaveElev(2*I-1) + WaveField%WaveElevC0 (2,I) = TmpFFTWaveElev(2*I) ENDDO - InitOut%WaveElevC0(:,InitOut%NStepWave2) = 0.0_SiKi + WaveField%WaveElevC0(:,InitOut%NStepWave2) = 0.0_SiKi CALL ExitFFT(FFT_Data, ErrStatTmp) CALL SetErrStat(ErrStatTmp,'Error occured while cleaning up after the FFTs.', ErrStat,ErrMsg,RoutineName) @@ -424,11 +417,12 @@ END SUBROUTINE UserWaveElevations_Init !----------------------------------------------------------------------------------------------------------------------! !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE UserWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) +SUBROUTINE UserWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! This routine initializes the wave kinematics based on user-supplied data !---------------------------------------------------------------------------------------------------------------------------------- TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine - TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Initialization outputs + TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Initialization outputs + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField !< Initialization outputs INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None @@ -477,7 +471,7 @@ SUBROUTINE UserWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) InitOut%WaveDOmega = TwoPi/InitInp%WaveTMax ! bjj added this ! >>> Allocate and initialize (set to 0) InitOut arrays - call Initial_InitOut_Arrays(InitOut, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) + call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ALLOCATE ( WaveDataStr ( InitInp%NGrid(1) ) , STAT=ErrStatTmp ) @@ -537,19 +531,19 @@ SUBROUTINE UserWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) SELECT CASE (iFile) CASE (1) - InitOut%WaveVel (m,i,j,k,1) = WaveData + WaveField%WaveVel (m,i,j,k,1) = WaveData CASE (2) - InitOut%WaveVel (m,i,j,k,2) = WaveData + WaveField%WaveVel (m,i,j,k,2) = WaveData CASE (3) - InitOut%WaveVel (m,i,j,k,3) = WaveData + WaveField%WaveVel (m,i,j,k,3) = WaveData CASE (4) - InitOut%WaveAcc (m,i,j,k,1) = WaveData + WaveField%WaveAcc (m,i,j,k,1) = WaveData CASE (5) - InitOut%WaveAcc (m,i,j,k,2) = WaveData + WaveField%WaveAcc (m,i,j,k,2) = WaveData CASE (6) - InitOut%WaveAcc (m,i,j,k,3) = WaveData + WaveField%WaveAcc (m,i,j,k,3) = WaveData CASE (7) - InitOut%WaveDynP(m,i,j,k ) = WaveData + WaveField%WaveDynP(m,i,j,k ) = WaveData END SELECT icount = icount + 1 END DO @@ -590,9 +584,9 @@ SUBROUTINE UserWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) isNumeric = is_numeric(WaveDataStr(i), WaveData) IF (.NOT. isNumeric ) THEN - InitOut%WaveElev(m,i,j ) = 0.0 + WaveField%WaveElev1(m,i,j ) = 0.0 ELSE - InitOut%WaveElev(m,i,j ) = WaveData + WaveField%WaveElev1(m,i,j ) = WaveData END IF END DO end do @@ -880,10 +874,11 @@ END SUBROUTINE WaveComp_ReadFile !! Final timestep must match given WaveTMax in HydroDyn input file !! NOTE: Wave frequency cutoffs can are applied to the read in wave elevation time series !! -SUBROUTINE UserWaveComponents_Init ( InitInp, InitOut, ErrStat, ErrMsg ) +SUBROUTINE UserWaveComponents_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) !---------------------------------------------------------------------------------------------------------------------------------- TYPE(Waves_InitInputType), INTENT(INOUT) :: InitInp !< Input data for initialization routine TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut !< Initialization outputs + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField !< Initialization outputs INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -933,7 +928,7 @@ SUBROUTINE UserWaveComponents_Init ( InitInp, InitOut, ErrStat, ErrMsg ) ! >>> Allocate and initialize (set to 0) InitOut arrays - call Initial_InitOut_Arrays(InitOut, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) + call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ALLOCATE ( IsSpecified( 0:InitOut%NStepWave2 ), STAT = ErrStatTmp) @@ -953,9 +948,9 @@ SUBROUTINE UserWaveComponents_Init ( InitInp, InitOut, ErrStat, ErrMsg ) J = NINT(WaveCompData%WaveAngFreq(I)/InitOut%WaveDOmega) IF ( .NOT. IsSpecified(J) ) THEN IsSpecified(J) = .TRUE. - InitOut%WaveElevC0(1,J) = WaveCompData%WaveAmp(I) * COS(WaveCompData%WavePhase(I)) * InitOut%NStepWave2 - InitOut%WaveElevC0(2,J) = WaveCompData%WaveAmp(I) * SIN(WaveCompData%WavePhase(I)) * InitOut%NStepWave2 - InitOut%WaveDirArr(J) = WaveCompData%WaveDir(I) + WaveField%WaveElevC0(1,J) = WaveCompData%WaveAmp(I) * COS(WaveCompData%WavePhase(I)) * InitOut%NStepWave2 + WaveField%WaveElevC0(2,J) = WaveCompData%WaveAmp(I) * SIN(WaveCompData%WavePhase(I)) * InitOut%NStepWave2 + WaveField%WaveDirArr(J) = WaveCompData%WaveDir(I) ELSE CALL SetErrStat(ErrID_Fatal,'Wave component with angular frequency ' //TRIM( Num2Lstr( WaveCompData%WaveAngFreq(I) ) )// & ' is listed twice in ' //TRIM(InitInp%WvKinFile)// '.',ErrStat,ErrMsg,RoutineName) @@ -964,8 +959,8 @@ SUBROUTINE UserWaveComponents_Init ( InitInp, InitOut, ErrStat, ErrMsg ) END IF END DO ! Make sure the DC and Nyquist components are zero - should be redundant - InitOut%WaveElevC0(:,0 ) = 0.0_SiKi - InitOut%WaveElevC0(:,InitOut%NStepWave2) = 0.0_SiKi + WaveField%WaveElevC0(:,0 ) = 0.0_SiKi + WaveField%WaveElevC0(:,InitOut%NStepWave2) = 0.0_SiKi CALL CleanUp() diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index 7fad44dc63..da9b3102fe 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -24,6 +24,7 @@ MODULE Waves USE Waves_Types USE UserWaves + USE SeaSt_WaveField_Types USE NWTC_Library USE NWTC_FFTPACK USE NWTC_RandomNumber @@ -545,13 +546,14 @@ END FUNCTION SINHNumOvrSINHDen !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE StillWaterWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) +SUBROUTINE StillWaterWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! This routine initializes the waves data for WaveMod = 0 , or still water waves option !---------------------------------------------------------------------------------------------------------------------------------- TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Initialization output data + 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 @@ -575,7 +577,7 @@ SUBROUTINE StillWaterWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) InitOut%WaveDOmega = 0.0 ! >>> Allocate and initialize (set to 0) InitOut arrays - call Initial_InitOut_Arrays(InitOut, InitInp, 1.0_DbKi, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) + call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, 1.0_DbKi, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IF ( ErrStat >= AbortErrLev ) RETURN @@ -589,8 +591,8 @@ SUBROUTINE StillWaterWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) do j = 1, InitInp%NGrid(2) do i = 1, InitInp%NGrid(1) count = count + 1 - InitOut%WaveVel(:,i,j,k,1) = InitInp%CurrVxi(count) ! xi-direction - InitOut%WaveVel(:,i,j,k,2) = InitInp%CurrVyi(count) ! yi-direction + 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 @@ -601,76 +603,72 @@ END SUBROUTINE StillWaterWaves_Init !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) +SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Compute the wave kinematics and related information for Plane progressive (regular) wave, JONSWAP/Pierson-Moskowitz spectrum ! (irregular) wave, or user-defined spectrum (irregular) wave. !---------------------------------------------------------------------------------------------------------------------------------- TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Output data + 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 - 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) - COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0HyiPz0 (:,:) ! Partial derivative of WaveAccC0Hyi(:) with respect to zi at zi = 0 (1/s^2) - COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0VPz0 (:,:) ! Partial derivative of WaveAccC0V (:) with respect to zi at zi = 0 (1/s^2) - COMPLEX(SiKi), ALLOCATABLE :: PWaveDynPC0BPz0(:,:) ! Partial derivative of WaveDynPC0B (:) with respect to zi at zi = 0 (N/m ) - COMPLEX(SiKi), ALLOCATABLE :: PWaveVelC0HxiPz0 (:,:) ! Partial derivative of WaveVelC0Hxi(:) with respect to zi at zi = 0 (1/s ) - COMPLEX(SiKi), ALLOCATABLE :: PWaveVelC0HyiPz0 (:,:) ! Partial derivative of WaveVelC0Hyi(:) with respect to zi at zi = 0 (1/s ) - COMPLEX(SiKi), ALLOCATABLE :: PWaveVelC0VPz0 (:,:) ! Partial derivative of WaveVelC0V (:) with respect to zi at zi = 0 (1/s ) - COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0Hxi(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0Hyi(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0V(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - COMPLEX(SiKi), ALLOCATABLE :: WaveDynPC0(:,:) ! Discrete Fourier transform of the instantaneous dynamic pressure of incident waves before applying stretching at the zi-coordinates for points (N/m^2) - COMPLEX(SiKi), ALLOCATABLE :: WaveVelC0Hxi(:,:) ! Discrete Fourier transform of the instantaneous horizontal velocity of incident waves before applying stretching at the zi-coordinates for points (m/s) - COMPLEX(SiKi), ALLOCATABLE :: WaveVelC0Hyi(:,:) ! Discrete Fourier transform of the instantaneous horizontal velocity in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s) - COMPLEX(SiKi), ALLOCATABLE :: WaveVelC0V(:,:) ! Discrete Fourier transform of the instantaneous vertical velocity in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s) - - REAL(SiKi), ALLOCATABLE :: CosWaveDir(:) ! COS( WaveDirArr(I) ) -- Each wave frequency has a unique wave direction. - REAL(SiKi), ALLOCATABLE :: GHWaveAcc (:,:) ! Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the GHNWvDpth vertical locations in GH Bladed wave data files (m/s^2) - REAL(SiKi), ALLOCATABLE :: GHWaveDynP(: ) ! Instantaneous dynamic pressure of incident waves at each of the GHNWvDpth vertical locations in GH Bladed wave data files (N/m^2) - - REAL(SiKi), ALLOCATABLE :: GHWaveVel (:,:) ! Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the GHNWvDpth vertical locations in GH Bladed wave data files (m/s ) - REAL(SiKi), ALLOCATABLE :: GHWvDpth (:) ! Vertical locations in GH Bladed wave data files. - - REAL(SiKi), ALLOCATABLE :: PWaveAcc0HxiPz0(:,:) ! Partial derivative of WaveAcc0Hxi(:) with respect to zi at zi = 0 (1/s^2) - REAL(SiKi), ALLOCATABLE :: PWaveAcc0HyiPz0(:,:) ! Partial derivative of WaveAcc0Hyi(:) with respect to zi at zi = 0 (1/s^2) - REAL(SiKi), ALLOCATABLE :: PWaveAcc0VPz0 (:,:) ! Partial derivative of WaveAcc0V (:) with respect to zi at zi = 0 (1/s^2) - REAL(SiKi), ALLOCATABLE :: PWaveDynP0BPz0 (:,:) ! Partial derivative of WaveDynP0B (:) with respect to zi at zi = 0 (N/m ) - REAL(SiKi), ALLOCATABLE :: PWaveVel0HxiPz0(:,:) ! Partial derivative of WaveVel0Hxi(:) with respect to zi at zi = 0 (1/s ) - REAL(SiKi), ALLOCATABLE :: PWaveVel0HyiPz0(:,:) ! Partial derivative of WaveVel0Hyi(:) with respect to zi at zi = 0 (1/s ) - REAL(SiKi), ALLOCATABLE :: PWaveVel0VPz0 (:,:) ! Partial derivative of WaveVel0V (:) with respect to zi at zi = 0 (1/s ) - - REAL(SiKi), ALLOCATABLE :: SinWaveDir (:) ! SIN( WaveDirArr(I) ) - REAL(SiKi), ALLOCATABLE :: WaveAcc0Hxi (:,:) ! Instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - REAL(SiKi), ALLOCATABLE :: WaveAcc0Hyi (:,:) ! Instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - - REAL(SiKi), ALLOCATABLE :: WaveAcc0V (:,:) ! Instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - - REAL(SiKi), ALLOCATABLE :: WaveDynP0B(:,:) ! Instantaneous dynamic pressure of incident waves before applying stretching at the zi-coordinates for points (N/m^2) + COMPLEX(SiKi) :: ImagOmega ! = ImagNmbr*Omega (rad/s) + COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0HxiPz0(:,:) ! Partial derivative of WaveAccC0Hxi(:) with respect to zi at zi = 0 (1/s^2) + COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0HyiPz0(:,:) ! Partial derivative of WaveAccC0Hyi(:) with respect to zi at zi = 0 (1/s^2) + COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0VPz0(:,:) ! Partial derivative of WaveAccC0V (:) with respect to zi at zi = 0 (1/s^2) + COMPLEX(SiKi), ALLOCATABLE :: PWaveDynPC0BPz0(:,:) ! Partial derivative of WaveDynPC0B (:) with respect to zi at zi = 0 (N/m ) + COMPLEX(SiKi), ALLOCATABLE :: PWaveVelC0HxiPz0(:,:) ! Partial derivative of WaveVelC0Hxi(:) with respect to zi at zi = 0 (1/s ) + COMPLEX(SiKi), ALLOCATABLE :: PWaveVelC0HyiPz0(:,:) ! Partial derivative of WaveVelC0Hyi(:) with respect to zi at zi = 0 (1/s ) + COMPLEX(SiKi), ALLOCATABLE :: PWaveVelC0VPz0(:,:) ! Partial derivative of WaveVelC0V (:) with respect to zi at zi = 0 (1/s ) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0Hxi(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0Hyi(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0V(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveDynPC0(:,:) ! Discrete Fourier transform of the instantaneous dynamic pressure of incident waves before applying stretching at the zi-coordinates for points (N/m^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveVelC0Hxi(:,:) ! Discrete Fourier transform of the instantaneous horizontal velocity of incident waves before applying stretching at the zi-coordinates for points (m/s) + COMPLEX(SiKi), ALLOCATABLE :: WaveVelC0Hyi(:,:) ! Discrete Fourier transform of the instantaneous horizontal velocity in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s) + COMPLEX(SiKi), ALLOCATABLE :: WaveVelC0V(:,:) ! Discrete Fourier transform of the instantaneous vertical velocity in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s) + + REAL(SiKi), ALLOCATABLE :: CosWaveDir(:) ! COS( WaveDirArr(I) ) -- Each wave frequency has a unique wave direction. + REAL(SiKi), ALLOCATABLE :: GHWaveAcc (:,:) ! Instantaneous acceleration of incident waves in the xi-(1), yi-(2), and zi-(3) directions, respectively, at each of the GHNWvDpth vertical locations in GH Bladed wave data files (m/s^2) + REAL(SiKi), ALLOCATABLE :: GHWaveDynP(: ) ! Instantaneous dynamic pressure of incident waves at each of the GHNWvDpth vertical locations in GH Bladed wave data files (N/m^2) + REAL(SiKi), ALLOCATABLE :: GHWaveVel (:,:) ! Instantaneous velocity of incident waves in the xi-(1), yi-(2), and zi-(3) directions, respectively, at each of the GHNWvDpth vertical locations in GH Bladed wave data files (m/s ) + REAL(SiKi), ALLOCATABLE :: GHWvDpth (:) ! Vertical locations in GH Bladed wave data files. + + REAL(SiKi), ALLOCATABLE :: PWaveAcc0HxiPz0(:,:) ! Partial derivative of WaveAcc0Hxi(:) with respect to zi at zi = 0 (1/s^2) + REAL(SiKi), ALLOCATABLE :: PWaveAcc0HyiPz0(:,:) ! Partial derivative of WaveAcc0Hyi(:) with respect to zi at zi = 0 (1/s^2) + REAL(SiKi), ALLOCATABLE :: PWaveAcc0VPz0 (:,:) ! Partial derivative of WaveAcc0V (:) with respect to zi at zi = 0 (1/s^2) + REAL(SiKi), ALLOCATABLE :: PWaveDynP0BPz0 (:,:) ! Partial derivative of WaveDynP0B (:) with respect to zi at zi = 0 (N/m ) + REAL(SiKi), ALLOCATABLE :: PWaveVel0HxiPz0(:,:) ! Partial derivative of WaveVel0Hxi(:) with respect to zi at zi = 0 (1/s ) + REAL(SiKi), ALLOCATABLE :: PWaveVel0HyiPz0(:,:) ! Partial derivative of WaveVel0Hyi(:) with respect to zi at zi = 0 (1/s ) + REAL(SiKi), ALLOCATABLE :: PWaveVel0VPz0 (:,:) ! Partial derivative of WaveVel0V (:) with respect to zi at zi = 0 (1/s ) + + REAL(SiKi), ALLOCATABLE :: SinWaveDir (:) ! SIN( WaveDirArr(I) ) + REAL(SiKi), ALLOCATABLE :: WaveAcc0Hxi (:,:) ! Instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + REAL(SiKi), ALLOCATABLE :: WaveAcc0Hyi (:,:) ! Instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + REAL(SiKi), ALLOCATABLE :: WaveAcc0V (:,:) ! Instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + REAL(SiKi), ALLOCATABLE :: WaveDynP0B(:,:) ! Instantaneous dynamic pressure of incident waves before applying stretching at the zi-coordinates for points (N/m^2) COMPLEX(SiKi) :: WaveElevxiPrime0 - REAL(SiKi), ALLOCATABLE :: WaveKinzi0Prime(:) ! zi-coordinates for points where the incident wave kinematics will be computed before applying stretching; these are relative to the mean see level (meters) + REAL(SiKi), ALLOCATABLE :: WaveKinzi0Prime(:) ! zi-coordinates for points where the incident wave kinematics will be computed before applying stretching; these are relative to the mean see level (meters) INTEGER , ALLOCATABLE :: WaveKinPrimeMap(:) - REAL(SiKi) :: WaveNmbr ! Wavenumber of the current frequency component (1/meter) - REAL(SiKi), ALLOCATABLE :: WaveVel0Hxi (:,:) ! Instantaneous xi-direction velocity of incident waves before applying stretching at the zi-coordinates for points (m/s ) - REAL(SiKi), ALLOCATABLE :: WaveVel0Hyi (:,:) ! Instantaneous yi-direction velocity of incident waves before applying stretching at the zi-coordinates for points (m/s ) - REAL(SiKi), ALLOCATABLE :: WaveVel0V (:,:) ! Instantaneous vertical velocity of incident waves before applying stretching at the zi-coordinates for points (m/s ) - INTEGER :: I,count ! Generic index - INTEGER :: J ! Generic index - INTEGER :: K ! Generic index - INTEGER :: NWaveKin0Prime ! Number of points where the incident wave kinematics will be computed before applying stretching to the instantaneous free surface (-) - integer :: primeCount ! Counter for locations before applying stretching - COMPLEX(SiKi) :: tmpComplex ! A temporary varible to hold the complex value of the wave elevation before storing it into a REAL array - COMPLEX(SiKi),ALLOCATABLE :: tmpComplexArr(:) ! A temporary array (0:NStepWave2-1) for FFT use. - TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using - - REAL(SiKi), ALLOCATABLE :: WaveS1SddArr(:) !< One-sided power spectral density of the wave spectrum at all non-negative frequencies (m^2/(rad/s)) - REAL(SiKi), ALLOCATABLE :: OmegaArr(:) !< Array of all non-negative angular frequencies (rad/s) + REAL(SiKi) :: WaveNmbr ! Wavenumber of the current frequency component (1/meter) + REAL(SiKi), ALLOCATABLE :: WaveVel0Hxi (:,:) ! Instantaneous xi-direction velocity of incident waves before applying stretching at the zi-coordinates for points (m/s ) + REAL(SiKi), ALLOCATABLE :: WaveVel0Hyi (:,:) ! Instantaneous yi-direction velocity of incident waves before applying stretching at the zi-coordinates for points (m/s ) + REAL(SiKi), ALLOCATABLE :: WaveVel0V (:,:) ! Instantaneous vertical velocity of incident waves before applying stretching at the zi-coordinates for points (m/s ) + INTEGER :: I,J,K,count ! Generic index + INTEGER :: NWaveKin0Prime ! Number of points where the incident wave kinematics will be computed before applying stretching to the instantaneous free surface (-) + integer :: primeCount ! Counter for locations before applying stretching + COMPLEX(SiKi) :: tmpComplex ! A temporary varible to hold the complex value of the wave elevation before storing it into a REAL array + COMPLEX(SiKi),ALLOCATABLE :: tmpComplexArr(:) ! A temporary array (0:NStepWave2-1) for FFT use. + TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using + + REAL(SiKi), ALLOCATABLE :: WaveS1SddArr(:) !< One-sided power spectral density of the wave spectrum at all non-negative frequencies (m^2/(rad/s)) + REAL(SiKi), ALLOCATABLE :: OmegaArr(:) !< Array of all non-negative angular frequencies (rad/s) ! Variables for MacCamy-Fuchs model REAL(SiKi) :: ka @@ -678,27 +676,26 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) REAL(SiKi) :: YPrime REAL(SiKi) :: HPrime REAL(SiKi) :: MCFC - COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0HxiMCF(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0HyiMCF(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0VMCF(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0HxiMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0HyiMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0VMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - REAL(SiKi), ALLOCATABLE :: WaveAcc0HxiMCF(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - REAL(SiKi), ALLOCATABLE :: WaveAcc0HyiMCF(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - REAL(SiKi), ALLOCATABLE :: WaveAcc0VMCF(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - REAL(SiKi), ALLOCATABLE :: PWaveAcc0HxiMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - REAL(SiKi), ALLOCATABLE :: PWaveAcc0HyiMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) - REAL(SiKi), ALLOCATABLE :: PWaveAcc0VMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0HxiMCF(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0HyiMCF(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccC0VMCF(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0HxiMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0HyiMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0VMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + REAL(SiKi), ALLOCATABLE :: WaveAcc0HxiMCF(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + REAL(SiKi), ALLOCATABLE :: WaveAcc0HyiMCF(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + REAL(SiKi), ALLOCATABLE :: WaveAcc0VMCF(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + REAL(SiKi), ALLOCATABLE :: PWaveAcc0HxiMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + REAL(SiKi), ALLOCATABLE :: PWaveAcc0HyiMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + REAL(SiKi), ALLOCATABLE :: PWaveAcc0VMCFPz0(:,:) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) ! Variables for error handling - INTEGER(IntKi) :: ErrStatTmp !< Temporary error status - CHARACTER(ErrMsgLen) :: ErrMsgTmp !< Temporary error message - character(*), parameter :: RoutineName = 'VariousWaves_Init' - - ! Initialize ErrStat + INTEGER(IntKi) :: ErrStatTmp !< Temporary error status + CHARACTER(ErrMsgLen) :: ErrMsgTmp !< Temporary error message + CHARACTER(*), PARAMETER :: RoutineName = 'VariousWaves_Init' + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -790,7 +787,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) InitOut%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, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) + call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) ENDIF !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @@ -863,8 +860,8 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) ALLOCATE ( WaveAcc0VMCF (0:InitOut%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0VMCF.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( InitOut%WaveAccMCF (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveAccMCF.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveField%WaveAccMCF (0:InitOut%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 @@ -912,14 +909,14 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) ALLOCATE ( PWaveAcc0VPz0 (0:InitOut%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0VPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( InitOut%PWaveDynP0 (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%PWaveDynP0.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveField%PWaveDynP0 (0:InitOut%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 ( InitOut%PWaveVel0 (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%PWaveVel0.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveField%PWaveVel0 (0:InitOut%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 ( InitOut%PWaveAcc0 (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%PWaveAcc0.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveField%PWaveAcc0 (0:InitOut%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 (InitInp%MCFD > 0.0_ReKi) THEN ! MacCamy-Fuchs model @@ -941,8 +938,8 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) ALLOCATE ( PWaveAcc0VMCFPz0 (0:InitOut%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0VMCFPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( InitOut%PWaveAccMCF0 (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%PWaveAccMCF0.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveField%PWaveAccMCF0 (0:InitOut%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 @@ -980,11 +977,11 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) OmegaArr(I) = I*InitOut%WaveDOmega END DO - call Get_1Spsd_and_WaveElevC0(InitInp, InitOut, OmegaArr, WaveS1SddArr) + call Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddArr) !> # Multi Directional Waves - call CalculateWaveDirection(InitInp, InitOut, ErrStatTmp, ErrMsgTmp) + call CalculateWaveDirection(InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp) call SetErrStat(ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -992,13 +989,13 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) END IF ! Store the minimum and maximum wave directions - InitOut%WaveDirMin = MINVAL(InitOut%WaveDirArr) - InitOut%WaveDirMax = MAXVAL(InitOut%WaveDirArr) + InitOut%WaveDirMin = MINVAL(WaveField%WaveDirArr) + InitOut%WaveDirMax = MAXVAL(WaveField%WaveDirArr) ! Set the CosWaveDir and SinWaveDir arrays - CosWaveDir=COS(D2R*InitOut%WaveDirArr) - SinWaveDir=SIN(D2R*InitOut%WaveDirArr) + CosWaveDir=COS(D2R*WaveField%WaveDirArr) + SinWaveDir=SIN(D2R*WaveField%WaveDirArr) ! make sure this is called before calling ConstrainedNewWaves @@ -1015,7 +1012,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) ! Only do this if WaveMod = 2 (JONSWAP/Pierson-Moskowitz Spectrum) and ConstWaveMod > 0 IF ( InitInp%WaveMod == 2 .AND. InitInp%ConstWaveMod > 0) THEN ! adjust InitOut%WaveElevC0 for constrained wave: - call ConstrainedNewWaves(InitInp, InitOut, OmegaArr, WaveS1SddArr, CosWaveDir, SinWaveDir, FFT_Data, ErrStatTmp, ErrMsgTmp) + 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() @@ -1036,7 +1033,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) DO I = 0,InitOut%NStepWave2 - tmpComplex = CMPLX( InitOut%WaveElevC0(1,I), InitOut%WaveElevC0(2,I)) + tmpComplex = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) ! some redundant calculations with later, but insignificant WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, InitInp%WtrDpth ) @@ -1045,8 +1042,8 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) 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) - InitOut%WaveElevC0 (1,I) = REAL( tmpComplex) - InitOut%WaveElevC0 (2,I) = AIMAG(tmpComplex) + WaveField%WaveElevC0 (1,I) = REAL( tmpComplex) + WaveField%WaveElevC0 (2,I) = AIMAG(tmpComplex) END DO END IF @@ -1063,7 +1060,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) ! Set tmpComplex to the Ith element of the WAveElevC0 array - tmpComplex = CMPLX( InitOut%WaveElevC0(1,I), InitOut%WaveElevC0(2,I)) + tmpComplex = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) ! Compute the frequency of this component and its imaginary value: @@ -1150,12 +1147,12 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) ! elevation of, velocity of, acceleration of, and loads associated with ! the incident waves are to be determined: DO I = 0,InitOut%NStepWave ! Loop through all time steps - InitOut%WaveTime(I) = I*REAL(InitInp%WaveDT,SiKi) + WaveField%WaveTime(I) = I*REAL(InitInp%WaveDT,SiKi) END DO ! I - All time steps DO I = 0,InitOut%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform - tmpComplexArr(I) = CMPLX(InitOut%WaveElevC0(1,I), InitOut%WaveElevC0(2,I)) + tmpComplexArr(I) = CMPLX(WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) END DO ! Compute the inverse discrete Fourier transforms to find the time-domain @@ -1173,8 +1170,8 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) 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), InitOut%WaveElev(:,i,j), InitOut%WaveElevC(:,:,k), tmpComplexArr, ErrStatTmp, ErrMsgTmp ) ! Note this sets tmpComplexArr - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to InitOut%WaveElev.',ErrStat,ErrMsg,RoutineName) + CALL WaveElevTimeSeriesAtXY( InitInp%WaveKinGridxi(k), InitInp%WaveKinGridyi(k), WaveField%WaveElev1(:,i,j), InitOut%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 @@ -1361,20 +1358,20 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) ! .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 WtrDpth have already been adjusted using MSL2SWL - InitOut%WaveDynP(:,i,j,k ) = 0.0 - InitOut%WaveVel (:,i,j,k,:) = 0.0 - InitOut%WaveAcc (:,i,j,k,:) = 0.0 + 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) - InitOut%WaveDynP(0:InitOut%NStepWave-1,i,j,k ) = WaveDynP0B( 0:InitOut%NStepWave-1,primeCount) - InitOut%WaveVel (0:InitOut%NStepWave-1,i,j,k,1) = WaveVel0Hxi(0:InitOut%NStepWave-1,primeCount) - InitOut%WaveVel (0:InitOut%NStepWave-1,i,j,k,2) = WaveVel0Hyi(0:InitOut%NStepWave-1,primeCount) - InitOut%WaveVel (0:InitOut%NStepWave-1,i,j,k,3) = WaveVel0V( 0:InitOut%NStepWave-1,primeCount) - InitOut%WaveAcc (0:InitOut%NStepWave-1,i,j,k,1) = WaveAcc0Hxi(0:InitOut%NStepWave-1,primeCount) - InitOut%WaveAcc (0:InitOut%NStepWave-1,i,j,k,2) = WaveAcc0Hyi(0:InitOut%NStepWave-1,primeCount) - InitOut%WaveAcc (0:InitOut%NStepWave-1,i,j,k,3) = WaveAcc0V( 0:InitOut%NStepWave-1,primeCount) + WaveField%WaveDynP(0:InitOut%NStepWave-1,i,j,k ) = WaveDynP0B( 0:InitOut%NStepWave-1,primeCount) + WaveField%WaveVel (0:InitOut%NStepWave-1,i,j,k,1) = WaveVel0Hxi(0:InitOut%NStepWave-1,primeCount) + WaveField%WaveVel (0:InitOut%NStepWave-1,i,j,k,2) = WaveVel0Hyi(0:InitOut%NStepWave-1,primeCount) + WaveField%WaveVel (0:InitOut%NStepWave-1,i,j,k,3) = WaveVel0V( 0:InitOut%NStepWave-1,primeCount) + WaveField%WaveAcc (0:InitOut%NStepWave-1,i,j,k,1) = WaveAcc0Hxi(0:InitOut%NStepWave-1,primeCount) + WaveField%WaveAcc (0:InitOut%NStepWave-1,i,j,k,2) = WaveAcc0Hyi(0:InitOut%NStepWave-1,primeCount) + WaveField%WaveAcc (0:InitOut%NStepWave-1,i,j,k,3) = WaveAcc0V( 0:InitOut%NStepWave-1,primeCount) primeCount = primeCount + 1 END IF count = count + 1 @@ -1392,12 +1389,12 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) IF ( ( InitInp%WaveKinGridzi(count) < -InitInp%WtrDpth ) .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 WtrDpth have already been adjusted using MSL2SWL - InitOut%WaveAccMCF(:,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) - InitOut%WaveAccMCF (0:InitOut%NStepWave-1,i,j,k,1) = WaveAcc0HxiMCF(0:InitOut%NStepWave-1,primeCount) - InitOut%WaveAccMCF (0:InitOut%NStepWave-1,i,j,k,2) = WaveAcc0HyiMCF(0:InitOut%NStepWave-1,primeCount) - InitOut%WaveAccMCF (0:InitOut%NStepWave-1,i,j,k,3) = WaveAcc0VMCF( 0:InitOut%NStepWave-1,primeCount) + WaveField%WaveAccMCF (0:InitOut%NStepWave-1,i,j,k,1) = WaveAcc0HxiMCF(0:InitOut%NStepWave-1,primeCount) + WaveField%WaveAccMCF (0:InitOut%NStepWave-1,i,j,k,2) = WaveAcc0HyiMCF(0:InitOut%NStepWave-1,primeCount) + WaveField%WaveAccMCF (0:InitOut%NStepWave-1,i,j,k,3) = WaveAcc0VMCF( 0:InitOut%NStepWave-1,primeCount) primeCount = primeCount + 1 END IF count = count + 1 @@ -1411,13 +1408,13 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) 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) - InitOut%PWaveDynP0(0:InitOut%NStepWave-1,i,j ) = PWaveDynP0BPz0( 0:InitOut%NStepWave-1,primeCount) - InitOut%PWaveVel0 (0:InitOut%NStepWave-1,i,j,1) = PWaveVel0HxiPz0(0:InitOut%NStepWave-1,primeCount) - InitOut%PWaveVel0 (0:InitOut%NStepWave-1,i,j,2) = PWaveVel0HyiPz0(0:InitOut%NStepWave-1,primeCount) - InitOut%PWaveVel0 (0:InitOut%NStepWave-1,i,j,3) = PWaveVel0VPz0( 0:InitOut%NStepWave-1,primeCount) - InitOut%PWaveAcc0 (0:InitOut%NStepWave-1,i,j,1) = pWaveAcc0HxiPz0(0:InitOut%NStepWave-1,primeCount) - InitOut%PWaveAcc0 (0:InitOut%NStepWave-1,i,j,2) = pWaveAcc0HyiPz0(0:InitOut%NStepWave-1,primeCount) - InitOut%PWaveAcc0 (0:InitOut%NStepWave-1,i,j,3) = PWaveAcc0VPz0( 0:InitOut%NStepWave-1,primeCount) + WaveField%PWaveDynP0(0:InitOut%NStepWave-1,i,j ) = PWaveDynP0BPz0( 0:InitOut%NStepWave-1,primeCount) + WaveField%PWaveVel0 (0:InitOut%NStepWave-1,i,j,1) = PWaveVel0HxiPz0(0:InitOut%NStepWave-1,primeCount) + WaveField%PWaveVel0 (0:InitOut%NStepWave-1,i,j,2) = PWaveVel0HyiPz0(0:InitOut%NStepWave-1,primeCount) + WaveField%PWaveVel0 (0:InitOut%NStepWave-1,i,j,3) = PWaveVel0VPz0( 0:InitOut%NStepWave-1,primeCount) + WaveField%PWaveAcc0 (0:InitOut%NStepWave-1,i,j,1) = pWaveAcc0HxiPz0(0:InitOut%NStepWave-1,primeCount) + WaveField%PWaveAcc0 (0:InitOut%NStepWave-1,i,j,2) = pWaveAcc0HyiPz0(0:InitOut%NStepWave-1,primeCount) + WaveField%PWaveAcc0 (0:InitOut%NStepWave-1,i,j,3) = PWaveAcc0VPz0( 0:InitOut%NStepWave-1,primeCount) primeCount = primeCount + 1 END DO END DO @@ -1426,9 +1423,9 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) 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) - InitOut%PWaveAccMCF0 (0:InitOut%NStepWave-1,i,j,1) = pWaveAcc0HxiMCFPz0(0:InitOut%NStepWave-1,primeCount) - InitOut%PWaveAccMCF0 (0:InitOut%NStepWave-1,i,j,2) = pWaveAcc0HyiMCFPz0(0:InitOut%NStepWave-1,primeCount) - InitOut%PWaveAccMCF0 (0:InitOut%NStepWave-1,i,j,3) = PWaveAcc0VMCFPz0( 0:InitOut%NStepWave-1,primeCount) + WaveField%PWaveAccMCF0 (0:InitOut%NStepWave-1,i,j,1) = pWaveAcc0HxiMCFPz0(0:InitOut%NStepWave-1,primeCount) + WaveField%PWaveAccMCF0 (0:InitOut%NStepWave-1,i,j,2) = pWaveAcc0HyiMCFPz0(0:InitOut%NStepWave-1,primeCount) + WaveField%PWaveAccMCF0 (0:InitOut%NStepWave-1,i,j,3) = PWaveAcc0VMCFPz0( 0:InitOut%NStepWave-1,primeCount) primeCount = primeCount + 1 END DO END DO @@ -1487,19 +1484,19 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) ! Set the ending timestep to the same as the first timestep InitOut%WaveElev0 (InitOut%NStepWave) = InitOut%WaveElev0 (0 ) - InitOut%WaveDynP (InitOut%NStepWave,:,:,: ) = InitOut%WaveDynP (0,:,:,: ) - InitOut%WaveVel (InitOut%NStepWave,:,:,:,:) = InitOut%WaveVel (0,:,:,:,:) - InitOut%WaveAcc (InitOut%NStepWave,:,:,:,:) = InitOut%WaveAcc (0,:,:,:,:) + WaveField%WaveDynP (InitOut%NStepWave,:,:,: ) = WaveField%WaveDynP (0,:,:,: ) + WaveField%WaveVel (InitOut%NStepWave,:,:,:,:) = WaveField%WaveVel (0,:,:,:,:) + WaveField%WaveAcc (InitOut%NStepWave,:,:,:,:) = WaveField%WaveAcc (0,:,:,:,:) IF (InitInp%MCFD > 0.0_SiKi) THEN - InitOut%WaveAccMCF (InitOut%NStepWave,:,:,:,:) = InitOut%WaveAccMCF(0,:,:,:,:) + WaveField%WaveAccMCF (InitOut%NStepWave,:,:,:,:) = WaveField%WaveAccMCF(0,:,:,:,:) END IF IF (InitInp%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching - InitOut%PWaveDynP0(InitOut%NStepWave,:,: ) = InitOut%PWaveDynP0(0,:,: ) - InitOut%PWaveVel0 (InitOut%NStepWave,:,:,:) = InitOut%PWaveVel0 (0,:,:,:) - InitOut%PWaveAcc0 (InitOut%NStepWave,:,:,:) = InitOut%PWaveAcc0 (0,:,:,:) + WaveField%PWaveDynP0(InitOut%NStepWave,:,: ) = WaveField%PWaveDynP0(0,:,: ) + WaveField%PWaveVel0 (InitOut%NStepWave,:,:,:) = WaveField%PWaveVel0 (0,:,:,:) + WaveField%PWaveAcc0 (InitOut%NStepWave,:,:,:) = WaveField%PWaveAcc0 (0,:,:,:) IF (InitInp%MCFD > 0.0_SiKi) THEN - InitOut%PWaveAccMCF0 (InitOut%NStepWave,:,:,:) = InitOut%PWaveAccMCF0(0,:,:,:) + WaveField%PWaveAccMCF0 (InitOut%NStepWave,:,:,:) = WaveField%PWaveAccMCF0(0,:,:,:) END IF END IF @@ -1534,7 +1531,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY(Xcoord,Ycoord, WaveElevAtXY, WaveElevCAtXY, tm DO I = 0,InitOut%NStepWave2 WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, InitInp%WtrDpth ) - tmpComplexArr(I) = CMPLX( InitOut%WaveElevC0(1,I), InitOut%WaveElevC0(2,I)) * & + tmpComplexArr(I) = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) * & EXP( -ImagNmbr*WaveNmbr*( Xcoord*CosWaveDir(I)+ & Ycoord*SinWaveDir(I) ) ) ENDDO @@ -1619,11 +1616,12 @@ 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, ErrStat, ErrMsg ) +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 @@ -1667,7 +1665,7 @@ SUBROUTINE Waves_Init( InitInp, InitOut, ErrStat, ErrMsg ) CASE ( 0 ) ! None=still water. - CALL StillWaterWaves_Init( InitInp, InitOut, ErrStatTmp, ErrMsgTmp ) + CALL StillWaterWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') IF ( ErrStat >= AbortErrLev ) RETURN @@ -1676,7 +1674,7 @@ SUBROUTINE Waves_Init( InitInp, InitOut, ErrStat, ErrMsg ) CASE ( 1, 2, 3, 4, 10 ) ! 1, 10: Plane progressive (regular) wave, 2: JONSWAP/Pierson-Moskowitz spectrum (irregular) wave, 3: white-noise, or 4: user-defined spectrum (irregular) wave. ! Now call the init with all the zi locations for the Morrison member nodes - CALL VariousWaves_Init( InitInp, InitOut, ErrStatTmp, ErrMsgTmp ) + CALL VariousWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') IF ( ErrStat >= AbortErrLev ) RETURN @@ -1684,31 +1682,31 @@ SUBROUTINE Waves_Init( InitInp, InitOut, ErrStat, ErrMsg ) CASE ( 5 ) ! User-supplied wave elevation time history; HD derives full wave kinematics from this elevation time series data. ! Get the wave frequency information from the file (by FFT of the elevation) - CALL UserWaveElevations_Init( InitInp, InitOut, ErrStatTmp, ErrMsgTmp ) + CALL UserWaveElevations_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') IF ( ErrStat >= AbortErrLev ) RETURN ! Now call VariousWaves to continue using the wave elevation and derived frequency information from the file - CALL VariousWaves_Init( InitInp, InitOut, ErrStatTmp, ErrMsgTmp ) + CALL VariousWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') IF ( ErrStat >= AbortErrLev ) RETURN CASE ( 6 ) ! User-supplied wave kinematics data. - CALL UserWaves_Init( InitInp, InitOut, ErrStatTmp, ErrMsgTmp ) + CALL UserWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') IF ( ErrStat >= AbortErrLev ) RETURN CASE ( 7 ) ! Get the wave frequency information from the file (by reading in wave frequency components) - CALL UserWaveComponents_Init( InitInp, InitOut, ErrStatTmp, ErrMsgTmp ) + CALL UserWaveComponents_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) 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, ErrStatTmp, ErrMsgTmp ) + CALL VariousWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') IF ( ErrStat >= AbortErrLev ) RETURN @@ -1905,12 +1903,13 @@ SUBROUTINE CalculateWaveNDir(InitInp, InitOut, ErrStat, ErrMsg) END SUBROUTINE CalculateWaveNDir !------------------------------------------------------------------------------------------------------------------------ -SUBROUTINE CalculateWaveDirection(InitInp, InitOut, ErrStat, ErrMsg ) +SUBROUTINE CalculateWaveDirection(InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Compute the wave direction array, InitOut%WaveDirArr !---------------------------------------------------------------------------------------------------------------------------------- TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Output data + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None @@ -1943,7 +1942,7 @@ SUBROUTINE CalculateWaveDirection(InitInp, InitOut, ErrStat, ErrMsg ) ELSEIF(.not. InitInp%WaveMultiDir .or. InitInp%WaveNDir <= 1) THEN ! we have a single wave direction - InitOut%WaveDirArr = InitInp%WaveDir + WaveField%WaveDirArr = InitInp%WaveDir ELSE ! multi directional waves @@ -2029,7 +2028,7 @@ SUBROUTINE CalculateWaveDirection(InitInp, InitOut, ErrStat, ErrMsg ) LastInd = MINLOC( WvSpreadThetaIdx, DIM=1 ) ! Assign the direction for this frequency piece to the LastInd value. - InitOut%WaveDirArr(K) = WvTheta( LastInd ) + WaveField%WaveDirArr(K) = WvTheta( LastInd ) ! Now make that element in the WvSpreadThetaIdx really big so we don't pick it again WvSpreadThetaIdx( LastInd ) = HUGE(1.0_SiKi) @@ -2042,7 +2041,7 @@ SUBROUTINE CalculateWaveDirection(InitInp, InitOut, ErrStat, ErrMsg ) ! Filling last value since it is not reached by the loop above CALL UniformRandomNumbers(InitInp%RNG%pRNG, WvSpreadThetaIdx) LastInd = MINLOC( WvSpreadThetaIdx, DIM=1 ) - InitOut%WaveDirArr(K) = WvTheta( LastInd ) + WaveField%WaveDirArr(K) = WvTheta( LastInd ) ! Perform a quick sanity check. We should have assigned all wave frequencies a direction, so K should be ! K = NStepWave2 (K is incrimented afterwards). @@ -2222,10 +2221,11 @@ end subroutine Cleanup END SUBROUTINE CalculateWaveSpreading !------------------------------------------------------------------------------------------------------------------------ !> sets WaveS1SddArr(:) and InitOut%WaveElevC0 -SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, OmegaArr, WaveS1SddArr) +SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddArr) TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Output data + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField REAL(SiKi), INTENT(IN ) :: OmegaArr(0:InitOut%NStepWave2) !< Array of all non-negative angular frequencies (rad/s) REAL(SiKi), INTENT( OUT) :: WaveS1SddArr(0:InitOut%NStepWave2) !< One-sided power spectral density of the wave spectrum at all non-negative frequencies (m^2/(rad/s)) @@ -2243,7 +2243,7 @@ SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, OmegaArr, WaveS1SddArr) ! Apply limits to the existing WaveElevC0 arrays if outside frequency range IF ( OmegaArr(I) < InitInp%WvLowCOff .OR. OmegaArr(I) > InitInp%WvHiCOff ) THEN - InitOut%WaveElevC0(:,I) = 0.0_SiKi + WaveField%WaveElevC0(:,I) = 0.0_SiKi ENDIF END DO @@ -2351,18 +2351,19 @@ SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, OmegaArr, WaveS1SddArr) ! Compute the discrete Fourier transform of the instantaneous elevation of ! incident waves at the WAMIT reference point: tmpComplex = SQRTNStepWave2 * WGNC(I) *SQRT( TwoPi_R4 * WaveS2Sdd / REAL(InitInp%WaveDT,SiKi) ) - InitOut%WaveElevC0 (1,I) = REAL( tmpComplex) - InitOut%WaveElevC0 (2,I) = AIMAG(tmpComplex) + WaveField%WaveElevC0 (1,I) = REAL( tmpComplex) + WaveField%WaveElevC0 (2,I) = AIMAG(tmpComplex) END DO ! I - The positive frequency components (including zero) of the discrete Fourier transforms END SUBROUTINE Get_1Spsd_and_WaveElevC0 !------------------------------------------------------------------------------------------------------------------------ !> update InitOut%WaveElevC0; call InitFFT before calling this routine! -SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, OmegaArr, WaveS1SddArr, CosWaveDir, SinWaveDir, FFT_Data, ErrStat, ErrMsg) +SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddArr, CosWaveDir, SinWaveDir, FFT_Data, ErrStat, ErrMsg) TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Output data + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField REAL(SiKi), INTENT(IN ) :: OmegaArr(0:InitOut%NStepWave2) !< Array of all non-negative angular frequencies (rad/s) REAL(SiKi), INTENT(IN ) :: WaveS1SddArr(0:InitOut%NStepWave2) !< One-sided power spectral density of the wave spectrum at all non-negative frequencies (m^2/(rad/s)) REAL(SiKi), INTENT(IN ) :: CosWaveDir(0:InitOut%NStepWave2) !< COS( WaveDirArr(I) ) -- Each wave frequency has a unique wave direction @@ -2410,11 +2411,11 @@ SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, OmegaArr, WaveS1SddArr, CosWave ! Compute the relevant sums m0 = InitOut%WaveDOmega * SUM(WaveS1SddArr) m2 = InitOut%WaveDOmega * SUM(WaveS1SddArr*OmegaArr*OmegaArr) - WaveElevC0ReSum = SUM(InitOut%WaveElevC0(1,:))/m0 - WaveElevC0ImOmegaSum = SUM(InitOut%WaveElevC0(2,:) * OmegaArr)/m2 + WaveElevC0ReSum = SUM(WaveField%WaveElevC0(1,:))/m0 + WaveElevC0ImOmegaSum = SUM(WaveField%WaveElevC0(2,:) * OmegaArr)/m2 ! Apply the part of the modification that is independent from the crest elevation - InitOut%WaveElevC0(1,:) = InitOut%WaveElevC0(1,:) - WaveElevC0ReSum * WaveS1SddArr * InitOut%WaveDOmega - InitOut%WaveElevC0(2,:) = InitOut%WaveElevC0(2,:) - WaveElevC0ImOmegaSum * OmegaArr * WaveS1SddArr * InitOut%WaveDOmega + WaveField%WaveElevC0(1,:) = WaveField%WaveElevC0(1,:) - WaveElevC0ReSum * WaveS1SddArr * InitOut%WaveDOmega + WaveField%WaveElevC0(2,:) = WaveField%WaveElevC0(2,:) - WaveElevC0ImOmegaSum * OmegaArr * WaveS1SddArr * InitOut%WaveDOmega Crest = 0.5_SiKi * InitInp%CrestHmax ! Set crest elevation to half of crest height tmpArr = InitOut%NStepWave2/m0 * InitOut%WaveDOmega * WaveS1SddArr @@ -2422,7 +2423,7 @@ SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, OmegaArr, WaveS1SddArr, CosWave IF (InitInp%ConstWaveMod == 1) THEN ! Crest elevation prescribed ! Apply the remaining part of the modification proportional to crest elevation - InitOut%WaveElevC0(1,:) = InitOut%WaveElevC0(1,:) + Crest * tmpArr + WaveField%WaveElevC0(1,:) = WaveField%WaveElevC0(1,:) + Crest * tmpArr ELSE IF (InitInp%ConstWaveMod == 2) THEN ! Crest height prescribed - Need to interate @@ -2434,8 +2435,8 @@ SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, OmegaArr, WaveS1SddArr, CosWave Iter = Iter + 1 ! Compute the crest height based on the current guess of crest elevation - tmpComplexArr = CMPLX( InitOut%WaveElevC0(1,:) + Crest * tmpArr, & - InitOut%WaveElevC0(2,:)) + tmpComplexArr = CMPLX( WaveField%WaveElevC0(1,:) + Crest * tmpArr, & + WaveField%WaveElevC0(2,:)) CALL ApplyFFT_cx ( InitOut%WaveElev0 (0:InitOut%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveElev0.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN @@ -2449,8 +2450,8 @@ SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, OmegaArr, WaveS1SddArr, CosWave If (CrestHeightError>CrestHeightTol) THEN ! If crest height tolerance is not satisfied ! Compute the crest height based on a slightly nudged crest elevation - tmpComplexArr = CMPLX( InitOut%WaveElevC0(1,:) + (Crest+CrestHeightTol) * tmpArr, & - InitOut%WaveElevC0(2,:)) + tmpComplexArr = CMPLX( WaveField%WaveElevC0(1,:) + (Crest+CrestHeightTol) * tmpArr, & + WaveField%WaveElevC0(2,:)) CALL ApplyFFT_cx ( InitOut%WaveElev0 (0:InitOut%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveElev0.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN @@ -2466,7 +2467,7 @@ SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, OmegaArr, WaveS1SddArr, CosWave END DO ! Apply the remaining part of the modification based on the final crest elevation - InitOut%WaveElevC0(1,:) = InitOut%WaveElevC0(1,:) + Crest * tmpArr + WaveField%WaveElevC0(1,:) = WaveField%WaveElevC0(1,:) + Crest * tmpArr ENDIF ! Modify the wave phase so that the crest shows up at the right place and the right time @@ -2475,10 +2476,10 @@ SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, OmegaArr, WaveS1SddArr, CosWave ConstWavePhase = WaveNmbr*(CosWaveDir(I)*InitInp%CrestXi + & SinWaveDir(I)*InitInp%CrestYi) - & OmegaArr(I)*InitInp%CrestTime - tmpComplex = CMPLX( InitOut%WaveElevC0(1,I) , InitOut%WaveElevC0(2,I) ) + tmpComplex = CMPLX( WaveField%WaveElevC0(1,I) , WaveField%WaveElevC0(2,I) ) tmpComplex = tmpComplex * CMPLX( cos(ConstWavePhase), sin(ConstWavePhase) ) - InitOut%WaveElevC0(1,I) = REAL(tmpComplex) - InitOut%WaveElevC0(2,I) = AIMAG(tmpComplex) + WaveField%WaveElevC0(1,I) = REAL(tmpComplex) + WaveField%WaveElevC0(2,I) = AIMAG(tmpComplex) END DO END SUBROUTINE ConstrainedNewWaves From edc8abe7f4a1155bfdc47a4b7df6ff85ccf05078 Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Fri, 26 May 2023 19:24:11 -0600 Subject: [PATCH 05/12] Switch to using WaveField in the Morison module * The Morison module should now always use the functions and subroutines of the wavefield module when accessing the wavefield data. * Direct access to the wavefield data from the Morison module has been removed. * Pointers to wavefield data no longer needed are also removed from HydroDyn. --- modules/hydrodyn/src/HydroDyn.f90 | 44 +- modules/hydrodyn/src/HydroDyn.txt | 16 +- modules/hydrodyn/src/HydroDyn_C_Binding.f90 | 25 +- modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 28 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 36 - modules/hydrodyn/src/Morison.f90 | 776 ++++-------------- modules/hydrodyn/src/Morison.txt | 138 ++-- modules/hydrodyn/src/Morison_Types.f90 | 816 +------------------ modules/openfast-library/src/FAST_Subs.f90 | 27 +- modules/seastate/src/SeaSt_WaveField.f90 | 219 +++-- 10 files changed, 428 insertions(+), 1697 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index acf680ac87..c02a5b99dc 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -581,44 +581,16 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I END IF - - - ! Are there Morison elements? - + ! Are there Morison elements? IF ( InputFileData%Morison%NMembers > 0 ) THEN - - - ! Copy SeaState initialization output into the initialization input type for the Morison module - + + ! Copy SeaState initialization output into the initialization input type for the Morison module InputFileData%Morison%NStepWave = InitInp%NStepWave - InputFileData%Morison%WaveTime => InitInp%WaveTime - - InputFileData%Morison%WaveAcc => InitInp%WaveAcc - InputFileData%Morison%WaveDynP => InitInp%WaveDynP - InputFileData%Morison%WaveVel => InitInp%WaveVel - InputFileData%Morison%PWaveAcc0 => InitInp%PWaveAcc0 - InputFileData%Morison%PWaveDynP0 => InitInp%PWaveDynP0 - InputFileData%Morison%PWaveVel0 => InitInp%PWaveVel0 - InputFileData%Morison%WaveElev1 => InitInp%WaveElev1 - InputFileData%Morison%WaveElev2 => InitInp%WaveElev2 - - InputFileData%Morison%MCFD = InitInp%MCFD - InputFileData%Morison%WaveAccMCF => InitInp%WaveAccMCF - InputFileData%Morison%PWaveAccMCF0 => InitInp%PWaveAccMCF0 - - InputFileData%Morison%WaveStMod = InitInp%WaveStMod - - ! CALL SeaSt_WaveField_CopySeaSt_WaveFieldType( InitInp%WaveField, InputFileData%Morison%WaveField, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + InputFileData%Morison%MCFD = InitInp%MCFD + InputFileData%Morison%WaveStMod = InitInp%WaveStMod InputFileData%Morison%WaveField => InitInp%WaveField - - ! If we did some second order wave kinematics corrections to the acceleration, velocity or - ! dynamic pressure using the Waves2 module, then we need to add these to the values that we - ! will be passing into the Morrison module. - - InputFileData%Morison%seast_interp_p = InitInp%seast_interp_p - - ! Initialize the Morison Element Calculations - + + ! Initialize the Morison Element Calculations CALL Morison_Init(InputFileData%Morison, u%Morison, p%Morison, x%Morison, xd%Morison, z%Morison, OtherState%Morison, & y%Morison, m%Morison, Interval, InitOut%Morison, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -627,7 +599,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I RETURN END IF - END IF ! ( InputFileData%Morison%NMembers > 0 ) + END IF ! Has Morison elements !=============================================== p%PotMod = InputFileData%Potmod diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 22fcf887e1..32d4eab3ea 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -104,14 +104,14 @@ typedef ^ ^ SiKi WaveElev1 typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation (points to SeaState module data)" - typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) typedef ^ ^ SiKi WaveTime {*} - - "Simulation times at which the instantaneous elevation of, velocity of, acceleration of, and loads associated with the incident waves are determined (points to SeaState module data)" (sec) -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 (points to SeaState module data)" (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 (points to SeaState module data)" (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 (points to SeaState module data)" (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.) (points to SeaState module data)" (m/s) -typedef ^ ^ SiKi PWaveDynP0 {*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed (points to SeaState module data)" (N/m^2) -typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "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 (points to SeaState module data)" (m/s^2) -typedef ^ ^ SiKi PWaveAccMCF0 {*}{*}{*}{*} - - "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 (points to SeaState module data)" (m/s^2) -typedef ^ ^ SiKi PWaveVel0 {*}{*}{*}{*} - - "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.) (points to SeaState module data)" (m/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 (points to SeaState module data)" (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 (points to SeaState module data)" (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 (points to SeaState module data)" (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.) (points to SeaState module data)" (m/s) +#typedef ^ ^ SiKi PWaveDynP0 {*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed (points to SeaState module data)" (N/m^2) +#typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "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 (points to SeaState module data)" (m/s^2) +#typedef ^ ^ SiKi PWaveAccMCF0 {*}{*}{*}{*} - - "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 (points to SeaState module data)" (m/s^2) +#typedef ^ ^ SiKi PWaveVel0 {*}{*}{*}{*} - - "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.) (points to SeaState module data)" (m/s) typedef ^ ^ SiKi WaveElevC0 {*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part (points to SeaState module data)" (meters) typedef ^ ^ SiKi WaveElevC {:}{:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) typedef ^ ^ SiKi WaveDirArr {*} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1 (points to SeaState module data)" (degrees) diff --git a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 index 37278bac6a..703a388cf0 100644 --- a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 +++ b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 @@ -426,27 +426,26 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, HD%InitInp%WaveDOmega = SeaSt%InitOutData%WaveDOmega HD%InitInp%MCFD = SeaSt%InitOutData%MCFD - CALL MOVE_ALLOC( SeaSt%InitOutData%WaveElev0, HD%InitInp%WaveElev0 ) + CALL MOVE_ALLOC( SeaSt%InitOutData%WaveElev0, HD%InitInp%WaveElev0 ) + CALL MOVE_ALLOC( SeaSt%InitOutData%WaveElevC, HD%InitInp%WaveElevC ) if(associated(SeaSt%InitOutData%WaveTime )) HD%InitInp%WaveTime => SeaSt%InitOutData%WaveTime - if(associated(SeaSt%InitOutData%WaveDynP )) HD%InitInp%WaveDynP => SeaSt%InitOutData%WaveDynP - if(associated(SeaSt%InitOutData%WaveAcc )) HD%InitInp%WaveAcc => SeaSt%InitOutData%WaveAcc - if(associated(SeaSt%InitOutData%WaveVel )) HD%InitInp%WaveVel => SeaSt%InitOutData%WaveVel - if(associated(SeaSt%InitOutData%PWaveDynP0)) HD%InitInp%PWaveDynP0 => SeaSt%InitOutData%PWaveDynP0 - if(associated(SeaSt%InitOutData%PWaveAcc0 )) HD%InitInp%PWaveAcc0 => SeaSt%InitOutData%PWaveAcc0 - if(associated(SeaSt%InitOutData%PWaveVel0 )) HD%InitInp%PWaveVel0 => SeaSt%InitOutData%PWaveVel0 if(associated(SeaSt%InitOutData%WaveElevC0)) HD%InitInp%WaveElevC0 => SeaSt%InitOutData%WaveElevC0 - CALL MOVE_ALLOC( SeaSt%InitOutData%WaveElevC, HD%InitInp%WaveElevC ) if(associated(SeaSt%InitOutData%WaveDirArr)) HD%InitInp%WaveDirArr => SeaSt%InitOutData%WaveDirArr if(associated(SeaSt%InitOutData%WaveElev1 )) HD%InitInp%WaveElev1 => SeaSt%InitOutData%WaveElev1 if(associated(SeaSt%InitOutData%WaveElev2 )) HD%InitInp%WaveElev2 => SeaSt%InitOutData%WaveElev2 - - HD%InitInp%WaveAccMCF => SeaSt%InitOutData%WaveAccMCF - HD%InitInp%PWaveAccMCF0 => SeaSt%InitOutData%PWaveAccMCF0 + if(associated(SeaSt%InitOutData%WaveField )) HD%InitInp%WaveField => SeaSt%InitOutData%WaveField + ! if(associated(SeaSt%InitOutData%WaveDynP )) HD%InitInp%WaveDynP => SeaSt%InitOutData%WaveDynP + ! if(associated(SeaSt%InitOutData%WaveAcc )) HD%InitInp%WaveAcc => SeaSt%InitOutData%WaveAcc + ! if(associated(SeaSt%InitOutData%WaveVel )) HD%InitInp%WaveVel => SeaSt%InitOutData%WaveVel + ! if(associated(SeaSt%InitOutData%PWaveDynP0)) HD%InitInp%PWaveDynP0 => SeaSt%InitOutData%PWaveDynP0 + ! if(associated(SeaSt%InitOutData%PWaveAcc0 )) HD%InitInp%PWaveAcc0 => SeaSt%InitOutData%PWaveAcc0 + ! if(associated(SeaSt%InitOutData%PWaveVel0 )) HD%InitInp%PWaveVel0 => SeaSt%InitOutData%PWaveVel0 + ! HD%InitInp%WaveAccMCF => SeaSt%InitOutData%WaveAccMCF + ! HD%InitInp%PWaveAccMCF0 => SeaSt%InitOutData%PWaveAccMCF0 call SeaSt_Interp_CopyParam(SeaSt%InitOutData%SeaSt_Interp_p, HD%InitInp%SeaSt_Interp_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - + ! Platform reference position ! The HD model uses this for building the moddel. This is only specified as an (X,Y) ! position (no Z). diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index 3071449298..fb1bc0d7b5 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -346,29 +346,25 @@ subroutine SetHD_InitInputs() InitInData_HD%WaveMultiDir = InitOutData_SeaSt%WaveMultiDir InitInData_HD%WaveDOmega = InitOutData_SeaSt%WaveDOmega InitInData_HD%MCFD = InitOutData_SeaSt%MCFD - !InitInData_HD%WaveElev0 => InitOutData_SeaSt%WaveElev0 - CALL MOVE_ALLOC( InitOutData_SeaSt%WaveElev0, InitInData_HD%WaveElev0 ) + CALL MOVE_ALLOC( InitOutData_SeaSt%WaveElev0, InitInData_HD%WaveElev0 ) + CALL MOVE_ALLOC( InitOutData_SeaSt%WaveElevC, InitInData_HD%WaveElevC ) InitInData_HD%WaveTime => InitOutData_SeaSt%WaveTime - InitInData_HD%WaveDynP => InitOutData_SeaSt%WaveDynP - InitInData_HD%WaveAcc => InitOutData_SeaSt%WaveAcc - InitInData_HD%WaveVel => InitOutData_SeaSt%WaveVel - - InitInData_HD%PWaveDynP0 => InitOutData_SeaSt%PWaveDynP0 - InitInData_HD%PWaveAcc0 => InitOutData_SeaSt%PWaveAcc0 - InitInData_HD%PWaveVel0 => InitOutData_SeaSt%PWaveVel0 - - InitInData_HD%WaveAccMCF => InitOutData_SeaSt%WaveAccMCF - InitInData_HD%PWaveAccMCF0 => InitOutData_SeaSt%PWaveAccMCF0 - InitInData_HD%WaveElevC0 => InitOutData_SeaSt%WaveElevC0 - CALL MOVE_ALLOC( InitOutData_SeaSt%WaveElevC, InitInData_HD%WaveElevC ) InitInData_HD%WaveDirArr => InitOutData_SeaSt%WaveDirArr InitInData_HD%WaveElev1 => InitOutData_SeaSt%WaveElev1 InitInData_HD%WaveElev2 => InitOutData_SeaSt%WaveElev2 + + ! InitInData_HD%WaveElev0 => InitOutData_SeaSt%WaveElev0 + ! InitInData_HD%WaveDynP => InitOutData_SeaSt%WaveDynP + ! InitInData_HD%WaveAcc => InitOutData_SeaSt%WaveAcc + ! InitInData_HD%WaveVel => InitOutData_SeaSt%WaveVel + ! InitInData_HD%PWaveDynP0 => InitOutData_SeaSt%PWaveDynP0 + ! InitInData_HD%PWaveAcc0 => InitOutData_SeaSt%PWaveAcc0 + ! InitInData_HD%PWaveVel0 => InitOutData_SeaSt%PWaveVel0 + ! InitInData_HD%WaveAccMCF => InitOutData_SeaSt%WaveAccMCF + ! InitInData_HD%PWaveAccMCF0 => InitOutData_SeaSt%PWaveAccMCF0 CALL SeaSt_Interp_CopyParam(InitOutData_SeaSt%SeaSt_Interp_p, InitInData_HD%SeaSt_Interp_p, MESH_NEWCOPY, ErrStat, ErrMsg ); CALL CheckError() - - ! CALL SeaSt_WaveField_CopySeaSt_WaveFieldType( InitOutData_SeaSt%WaveField, InitInData_HD%WaveField, MESH_NEWCOPY, ErrStat, ErrMsg ) InitInData_HD%WaveField => InitOutData_SeaSt%WaveField end subroutine SetHD_InitInputs diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index a5a140192f..d8b8add2ef 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -112,14 +112,6 @@ MODULE HydroDyn_Types REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation (points to SeaState module data) [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Simulation times at which the instantaneous elevation of, velocity of, acceleration of, and loads associated with the incident waves are determined (points to SeaState module data) [(sec)] - 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 (points to SeaState module data) [(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 (points to SeaState module data) [(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 (points to SeaState module data) [(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.) (points to SeaState module data) [(m/s)] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: PWaveDynP0 => 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 (points to SeaState module data) [(N/m^2)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => 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 (points to SeaState module data) [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAccMCF0 => 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 (points to SeaState module data) [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveVel0 => 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.) (points to SeaState module data) [(m/s)] REAL(SiKi) , DIMENSION(:,:), POINTER :: WaveElevC0 => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part (points to SeaState module data) [(meters)] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevC !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 (points to SeaState module data) [(degrees)] @@ -1744,8 +1736,6 @@ SUBROUTINE HydroDyn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyInitInput' @@ -1794,14 +1784,6 @@ SUBROUTINE HydroDyn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%WaveElev0 = SrcInitInputData%WaveElev0 ENDIF DstInitInputData%WaveTime => SrcInitInputData%WaveTime - DstInitInputData%WaveDynP => SrcInitInputData%WaveDynP - DstInitInputData%WaveAcc => SrcInitInputData%WaveAcc - DstInitInputData%WaveAccMCF => SrcInitInputData%WaveAccMCF - DstInitInputData%WaveVel => SrcInitInputData%WaveVel - DstInitInputData%PWaveDynP0 => SrcInitInputData%PWaveDynP0 - DstInitInputData%PWaveAcc0 => SrcInitInputData%PWaveAcc0 - DstInitInputData%PWaveAccMCF0 => SrcInitInputData%PWaveAccMCF0 - DstInitInputData%PWaveVel0 => SrcInitInputData%PWaveVel0 DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 IF (ALLOCATED(SrcInitInputData%WaveElevC)) THEN i1_l = LBOUND(SrcInitInputData%WaveElevC,1) @@ -1853,14 +1835,6 @@ SUBROUTINE HydroDyn_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) DEALLOCATE(InitInputData%WaveElev0) ENDIF NULLIFY(InitInputData%WaveTime) -NULLIFY(InitInputData%WaveDynP) -NULLIFY(InitInputData%WaveAcc) -NULLIFY(InitInputData%WaveAccMCF) -NULLIFY(InitInputData%WaveVel) -NULLIFY(InitInputData%PWaveDynP0) -NULLIFY(InitInputData%PWaveAcc0) -NULLIFY(InitInputData%PWaveAccMCF0) -NULLIFY(InitInputData%PWaveVel0) NULLIFY(InitInputData%WaveElevC0) IF (ALLOCATED(InitInputData%WaveElevC)) THEN DEALLOCATE(InitInputData%WaveElevC) @@ -2186,8 +2160,6 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackInitInput' @@ -2314,14 +2286,6 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta END DO END IF NULLIFY(OutData%WaveTime) - NULLIFY(OutData%WaveDynP) - NULLIFY(OutData%WaveAcc) - NULLIFY(OutData%WaveAccMCF) - NULLIFY(OutData%WaveVel) - NULLIFY(OutData%PWaveDynP0) - NULLIFY(OutData%PWaveAcc0) - NULLIFY(OutData%PWaveAccMCF0) - NULLIFY(OutData%PWaveVel0) NULLIFY(OutData%WaveElevC0) IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC not allocated Int_Xferred = Int_Xferred + 1 diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index b7ce83ea43..bd9d44fe4c 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -1908,24 +1908,21 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In character(*), parameter :: RoutineName = 'Morison_Init' - TYPE(Morison_MemberType) :: member ! the current member + TYPE(Morison_MemberType) :: member ! the current member INTEGER :: i, j, k REAL(ReKi) :: v2D(3,1), pos(3) real(ReKi) :: An(3), An_drag(3), Vn(3), I_n(3), sgn, Amag, Amag_drag, Vmag, Imag, Ir_MG_end, Il_MG_end, R_I(3,3), IRl_mat(3,3), tMG, MGdens integer(IntKi) :: MemberEndIndx - INTEGER, ALLOCATABLE :: commonNodeLst(:) - LOGICAL, ALLOCATABLE :: usedJointList(:) - integer(IntKi) :: errStat2 ! returns a non-zero value when an error occurs + INTEGER, ALLOCATABLE :: commonNodeLst(:) + LOGICAL, ALLOCATABLE :: usedJointList(:) + integer(IntKi) :: errStat2 ! returns a non-zero value when an error occurs CHARACTER(errMsgLen) :: errMsg2 ! Error message if errStat2 /= ErrID_None - - - ! Initialize errStat + + ! Initialize errStat errStat = ErrID_None errMsg = "" - - - - ! Define parameters here: + + ! Define parameters here: p%DT = Interval p%WtrDens = InitInp%WtrDens p%WtrDpth = InitInp%WtrDpth @@ -1946,10 +1943,8 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In p%AMMod = 0_IntKi END IF - p%WaveElev1 => InitInp%WaveElev1 - IF (associated(InitInp%WaveElev2)) THEN - p%WaveElev2 => InitInp%WaveElev2 - END IF + ! Pointer to SeaState WaveField + p%WaveField => InitInp%WaveField ALLOCATE ( p%MOutLst(p%NMOutputs), STAT = errStat2 ) IF ( errStat2 /= 0 ) THEN @@ -2244,50 +2239,6 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In ! Define system output initializations (set up mesh) here: ! Define initialization-routine output here: - - ! Setup the 4D grid information for the Interpolatin Module - p%seast_interp_p = InitInp%seast_interp_p - - ! Setup 3D SWL grids needed for wave stretching - - IF (p%WaveStMod > 0_IntKi) THEN ! Wave stretching enabled - - ! Allocate variables for the wave dynamics at the SWL - Needed for wave stretching - ALLOCATE ( p%WaveDynP0 (0:p%NStepWave,p%seast_interp_p%n(2),p%seast_interp_p%n(3)), STAT=errStat2 ) - IF ( errStat2 /= 0 ) call SetErrStat(ErrID_Fatal,'Error allocating space for p%WaveDynP0.', ErrStat, ErrMsg, RoutineName) - ALLOCATE ( p%WaveVel0 (0:p%NStepWave,p%seast_interp_p%n(2),p%seast_interp_p%n(3),3), STAT=errStat2 ) - IF ( errStat2 /= 0 ) call SetErrStat(ErrID_Fatal,'Error allocating space for p%WaveVel0.', ErrStat, ErrMsg, RoutineName) - ALLOCATE ( p%WaveAcc0 (0:p%NStepWave,p%seast_interp_p%n(2),p%seast_interp_p%n(3),3), STAT=errStat2 ) - IF ( errStat2 /= 0 ) call SetErrStat(ErrID_Fatal,'Error allocating space for p%WaveAcc0.', ErrStat, ErrMsg, RoutineName) - ALLOCATE ( p%WaveAccMCF0 (0:p%NStepWave,p%seast_interp_p%n(2),p%seast_interp_p%n(3),3), STAT=errstat2 ) - IF ( errStat2 /= 0 ) call SetErrStat(ErrID_Fatal,'Error allocating space for p%WaveAccMCF0.', ErrStat, ErrMsg, RoutineName) - - if (ErrStat >= AbortErrLev) RETURN - - ! Copy the wave data at the SWL - DO i = 1,p%seast_interp_p%n(2) - DO j = 1,p%seast_interp_p%n(3) - p%WaveDynP0(:,i,j) = p%WaveDynP(:,i,j,p%seast_interp_p%n(4)) - DO k = 1,3 - p%WaveVel0(:,i,j,k) = p%WaveVel(:,i,j,p%seast_interp_p%n(4),k) - p%WaveAcc0(:,i,j,k) = p%WaveAcc(:,i,j,p%seast_interp_p%n(4),k) - END DO - END DO - END DO - - ! Also copy the MacCamy-Fuchs scaled wave acceleration at the SWL if available - IF (ASSOCIATED(p%WaveAccMCF)) THEN - DO i = 1,p%seast_interp_p%n(2) - DO j = 1,p%seast_interp_p%n(3) - DO k = 1,3 - p%WaveAccMCF0(:,i,j,k) = p%WaveAccMCF(:,i,j,p%seast_interp_p%n(4),k) - END DO - END DO - END DO - END IF - - END IF - ! Initialize the outputs CALL MrsnOUT_Init( InitInp, y, p, InitOut, errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) @@ -2361,7 +2312,7 @@ FUNCTION GetAlpha(R1,R2) REAL(ReKi), INTENT ( IN ) :: R1 ! interior radius of element at node point REAL(ReKi), INTENT ( IN ) :: R2 ! interior radius of other end of part-element - IF ( EqualRealNos(R1, R2) ) THEN ! To cover the case where R1=R2=0 + IF ( EqualRealNos(R1, R2) ) THEN ! Also cover the case where R1=R2=0 GetAlpha = 0.5 ELSE GetAlpha = (R1*R1 + 2.0*R1*R2 + 3.0*R2*R2)/4.0/(R1*R1 + R1*R2 + R2*R2) @@ -2377,179 +2328,143 @@ SUBROUTINE AllocateNodeLoadVariables(InitInp, p, m, NNodes, errStat, errMsg ) INTEGER(IntKi), INTENT(IN ) :: NNodes ! number of nodes in node list INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation CHARACTER(*), INTENT( OUT) :: errMsg ! Error message if errStat /= ErrID_None - integer(IntKi) :: errStat2 ! returns a non-zero value when an error occurs - CHARACTER(errMsgLen) :: errMsg2 ! Error message if errStat2 /= ErrID_None - character(*), parameter :: routineName = 'AllocateNodeLoadVariables' + integer(IntKi) :: errStat2 ! Returns a non-zero value when an error occurs + CHARACTER(errMsgLen) :: errMsg2 ! Error message if errStat2 /= ErrID_None + character(*), parameter :: routineName = 'AllocateNodeLoadVariables' - ! Initialize errStat - + ! Initialize errStat errStat = ErrID_None errMsg = "" - call AllocAry( m%nodeInWater , NNodes , 'm%nodeInWater' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%vrel , 3, NNodes , 'm%vrel' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - !call AllocAry( m%F_D , 6, NNodes , 'm%F_D' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - !call AllocAry( m%F_A , 6, NNodes , 'm%F_A' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - !call AllocAry( m%F_B , 6, NNodes , 'm%F_B' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - !call AllocAry( m%F_BF , 6, NNodes , 'm%F_BF' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - !call AllocAry( m%F_I , 6, NNodes , 'm%F_I' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - !call AllocAry( m%F_If , 6, NNodes , 'm%F_If' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - !call AllocAry( m%F_WMG , 6, NNodes , 'm%F_WMG' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - !call AllocAry( m%F_IMG , 6, NNodes , 'm%F_IMG' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%FV , 3, NNodes , 'm%FV' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%FA , 3, NNodes , 'm%FA' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%FAMCF , 3, NNodes , 'm%FAMCF' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%FDynP , NNodes , 'm%FDynP' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%WaveElev , NNodes , 'm%WaveElev' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%WaveElev1 , NNodes , 'm%WaveElev1' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%WaveElev2 , NNodes , 'm%WaveElev2' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( p%An_End , 3, p%NJoints, 'p%An_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( p%DragConst_End, p%NJoints, 'p%DragConst_End', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%F_I_End , 3, p%NJoints, 'm%F_I_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%F_BF_End , 6, p%NJoints, 'm%F_BF_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%F_A_End , 3, p%NJoints, 'm%F_A_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%F_D_End , 3, p%NJoints, 'm%F_D_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%F_B_End , 6, p%NJoints, 'm%F_B_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%F_IMG_End , 6, p%NJoints, 'm%F_IMG_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( p%I_MG_End , 3, 3, p%NJoints, 'p%I_MG_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( p%F_WMG_End , 3, p%NJoints, 'p%F_WMG_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( p%Mass_MG_End , p%NJoints, 'p%Mass_MG_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( p%AM_End , 3, 3, p%NJoints, 'p%AM_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( p%DP_Const_End , 3, p%NJoints, 'p%DP_Const_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - - call AllocAry( m%V_rel_n , p%NJoints, 'm%V_rel_n' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( m%V_rel_n_HiPass , p%NJoints, 'm%V_rel_n_HiPass' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - - call AllocAry( p%DragMod_End , p%NJoints, 'p%DragMod_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( p%DragLoFSc_End , p%NJoints, 'p%DragLoFSc_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) - call AllocAry( p%VRelNFiltConst , p%NJoints, 'p%VRelNFiltConst' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%nodeInWater , NNodes , 'm%nodeInWater' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%vrel , 3, NNodes , 'm%vrel' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%FV , 3, NNodes , 'm%FV' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%FA , 3, NNodes , 'm%FA' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%FAMCF , 3, NNodes , 'm%FAMCF' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%FDynP , NNodes , 'm%FDynP' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%WaveElev , NNodes , 'm%WaveElev' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%WaveElev1 , NNodes , 'm%WaveElev1' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%WaveElev2 , NNodes , 'm%WaveElev2' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%An_End , 3, p%NJoints, 'p%An_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%DragConst_End, p%NJoints, 'p%DragConst_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%F_I_End , 3, p%NJoints, 'm%F_I_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%F_BF_End , 6, p%NJoints, 'm%F_BF_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%F_A_End , 3, p%NJoints, 'm%F_A_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%F_D_End , 3, p%NJoints, 'm%F_D_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%F_B_End , 6, p%NJoints, 'm%F_B_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%F_IMG_End , 6, p%NJoints, 'm%F_IMG_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%I_MG_End , 3, 3, p%NJoints, 'p%I_MG_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%F_WMG_End , 3, p%NJoints, 'p%F_WMG_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%Mass_MG_End , p%NJoints, 'p%Mass_MG_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%AM_End , 3, 3, p%NJoints, 'p%AM_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%DP_Const_End , 3, p%NJoints, 'p%DP_Const_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%V_rel_n , p%NJoints, 'm%V_rel_n' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( m%V_rel_n_HiPass , p%NJoints, 'm%V_rel_n_HiPass', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%DragMod_End , p%NJoints, 'p%DragMod_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%DragLoFSc_End , p%NJoints, 'p%DragLoFSc_End' , errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) + call AllocAry( p%VRelNFiltConst , p%NJoints, 'p%VRelNFiltConst', errStat2, errMsg2); call SetErrStat(errStat2, errMsg2, errStat, errMsg, routineName) if (errStat >= AbortErrLev) return - m%nodeInWater = 0 - m%vrel = 0.0_ReKi - !m%F_D = 0.0_ReKi - !m%F_A = 0.0_ReKi - !m%F_B = 0.0 - !m%F_BF = 0.0 - !m%F_I = 0.0 - !m%F_If = 0.0 - !m%F_WMG = 0.0 - !m%F_IMG = 0.0 - m%FV = 0.0_ReKi - m%FA = 0.0_ReKi - m%FDynP = 0.0_ReKi - p%An_End = 0.0 - p%DragConst_End = 0.0 - m%F_I_End = 0.0 - m%F_BF_End = 0.0 - m%F_A_End = 0.0 - m%F_D_End = 0.0 - m%F_B_End = 0.0 - m%F_IMG_End = 0.0 - p%DP_Const_End = 0.0 - p%I_MG_End = 0.0 - p%Mass_MG_End = 0.0 - p%F_WMG_End = 0.0 - p%AM_End = 0.0 - + m%nodeInWater = 0 + m%vrel = 0.0_ReKi + m%FV = 0.0_ReKi + m%FA = 0.0_ReKi + m%FDynP = 0.0_ReKi + p%An_End = 0.0 + p%DragConst_End = 0.0 + m%F_I_End = 0.0 + m%F_BF_End = 0.0 + m%F_A_End = 0.0 + m%F_D_End = 0.0 + m%F_B_End = 0.0 + m%F_IMG_End = 0.0 + p%DP_Const_End = 0.0 + p%I_MG_End = 0.0 + p%Mass_MG_End = 0.0 + p%F_WMG_End = 0.0 + p%AM_End = 0.0 m%V_rel_n = 0.0_ReKi m%V_rel_n_HiPass = 0.0_ReKi - - p%WaveVel => InitInp%WaveVel - p%WaveAcc => InitInp%WaveAcc - p%WaveDynP => InitInp%WaveDynP - p%WaveTime => InitInp%WaveTime - p%PWaveVel0 => InitInp%PWaveVel0 - p%PWaveAcc0 => InitInp%PWaveAcc0 - p%PWaveDynP0 => InitInp%PWaveDynP0 - - p%WaveAccMCF => InitInp%WaveAccMCF - p%PWaveAccMCF0 => InitInp%PWaveAccMCF0 - CALL SeaSt_WaveField_CopySeaSt_WaveFieldType( InitInp%WaveField, p%WaveField, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - END SUBROUTINE AllocateNodeLoadVariables -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is similar to InterpWrappedStpReal, except it returns only the slope for the interpolation. -!! By returning the slope based on Time, we don't have to calculate this for every variable (Yary) we want to interpolate. -!! NOTE: p%WaveTime (and most arrays here) start with index of 0 instead of 1, so we will subtract 1 from "normal" interpolation -!! schemes. -FUNCTION GetInterpolationSlope(Time, p, m, IntWrapIndx) RESULT( InterpSlope ) - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(Morison_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(Morison_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER, OPTIONAL, INTENT( OUT) :: IntWrapIndx - - REAL(SiKi) :: Time_SiKi - REAL(SiKi) :: TimeMod - REAL(ReKi) :: InterpSlope - - Time_SiKi = REAL(Time, SiKi) - TimeMod = MOD(Time_SiKi, p%WaveTime(p%NStepWave)) !p%WaveTime starts at index 0, so it has p%NStepWave+1 elements - IF ( TimeMod <= p%WaveTime(1) ) THEN !second element - m%LastIndWave = 0 - END IF - - IF ( TimeMod <= p%WaveTime(0) ) THEN - m%LastIndWave = 0 - InterpSlope = 0.0_ReKi ! returns values at m%LastIndWave - IF(PRESENT(IntWrapIndx)) IntWrapIndx = 0 - ELSE IF ( TimeMod >= p%WaveTime(p%NStepWave) ) THEN - m%LastIndWave = p%NStepWave-1 - InterpSlope = 1.0_ReKi ! returns values at p%NStepWave - IF(PRESENT(IntWrapIndx)) IntWrapIndx = p%NStepWave - ELSE - m%LastIndWave = MAX( MIN( m%LastIndWave, p%NStepWave-1 ), 0 ) - - DO - - IF ( TimeMod < p%WaveTime(m%LastIndWave) ) THEN - - m%LastIndWave = m%LastIndWave - 1 - - ELSE IF ( TimeMod >= p%WaveTime(m%LastIndWave+1) ) THEN - - m%LastIndWave = m%LastIndWave + 1 - - ELSE - IF(PRESENT(IntWrapIndx)) IntWrapIndx = m%LastIndWave - - InterpSlope = ( TimeMod - p%WaveTime(m%LastIndWave) )/( p%WaveTime(m%LastIndWave+1) - p%WaveTime(m%LastIndWave) ) - RETURN ! stop checking DO loop - END IF - - END DO - - END IF - -END FUNCTION GetInterpolationSlope -!---------------------------------------------------------------------------------------------------------------------------------- -!> Use in conjunction with GetInterpolationSlope, to replace InterpWrappedStpReal here. -FUNCTION InterpolateWithSlope(InterpSlope, Ind, YAry) - REAL(ReKi), INTENT(IN) :: InterpSlope - INTEGER(IntKi), INTENT(IN ) :: Ind !< Misc/optimization variables - REAL(SiKi), INTENT(IN) :: YAry(0:) - REAL(ReKi) :: InterpolateWithSlope - - InterpolateWithSlope = ( YAry(Ind+1) - YAry(Ind) )*InterpSlope + YAry(Ind) - -END FUNCTION InterpolateWithSlope -!---------------------------------------------------------------------------------------------------------------------------------- -!> Use in conjunction with GetInterpolationSlope, to replace InterpWrappedStpReal here. -FUNCTION InterpolateWithSlopeR(InterpSlope, Ind, YAry) - REAL(ReKi), INTENT(IN) :: InterpSlope - INTEGER(IntKi), INTENT(IN ) :: Ind !< Misc/optimization variables - REAL(ReKi), INTENT(IN) :: YAry(0:) - REAL(ReKi) :: InterpolateWithSlopeR - - InterpolateWithSlopeR = ( YAry(Ind+1) - YAry(Ind) )*InterpSlope + YAry(Ind) - -END FUNCTION InterpolateWithSlopeR +! !---------------------------------------------------------------------------------------------------------------------------------- +! !> This routine is similar to InterpWrappedStpReal, except it returns only the slope for the interpolation. +! !! By returning the slope based on Time, we don't have to calculate this for every variable (Yary) we want to interpolate. +! !! NOTE: p%WaveTime (and most arrays here) start with index of 0 instead of 1, so we will subtract 1 from "normal" interpolation +! !! schemes. +! FUNCTION GetInterpolationSlope(Time, p, m, IntWrapIndx) RESULT( InterpSlope ) +! REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds +! TYPE(Morison_ParameterType), INTENT(IN ) :: p !< Parameters +! TYPE(Morison_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables +! INTEGER, OPTIONAL, INTENT( OUT) :: IntWrapIndx +! +! REAL(SiKi) :: Time_SiKi +! REAL(SiKi) :: TimeMod +! REAL(ReKi) :: InterpSlope +! +! Time_SiKi = REAL(Time, SiKi) +! TimeMod = MOD(Time_SiKi, p%WaveTime(p%NStepWave)) !p%WaveTime starts at index 0, so it has p%NStepWave+1 elements +! IF ( TimeMod <= p%WaveTime(1) ) THEN !second element +! m%LastIndWave = 0 +! END IF +! +! IF ( TimeMod <= p%WaveTime(0) ) THEN +! m%LastIndWave = 0 +! InterpSlope = 0.0_ReKi ! returns values at m%LastIndWave +! IF(PRESENT(IntWrapIndx)) IntWrapIndx = 0 +! ELSE IF ( TimeMod >= p%WaveTime(p%NStepWave) ) THEN +! m%LastIndWave = p%NStepWave-1 +! InterpSlope = 1.0_ReKi ! returns values at p%NStepWave +! IF(PRESENT(IntWrapIndx)) IntWrapIndx = p%NStepWave +! ELSE +! m%LastIndWave = MAX( MIN( m%LastIndWave, p%NStepWave-1 ), 0 ) +! +! DO +! +! IF ( TimeMod < p%WaveTime(m%LastIndWave) ) THEN +! +! m%LastIndWave = m%LastIndWave - 1 +! +! ELSE IF ( TimeMod >= p%WaveTime(m%LastIndWave+1) ) THEN +! +! m%LastIndWave = m%LastIndWave + 1 +! +! ELSE +! IF(PRESENT(IntWrapIndx)) IntWrapIndx = m%LastIndWave +! +! InterpSlope = ( TimeMod - p%WaveTime(m%LastIndWave) )/( p%WaveTime(m%LastIndWave+1) - p%WaveTime(m%LastIndWave) ) +! RETURN ! stop checking DO loop +! END IF +! +! END DO +! +! END IF +! +! END FUNCTION GetInterpolationSlope +! !---------------------------------------------------------------------------------------------------------------------------------- +! !> Use in conjunction with GetInterpolationSlope, to replace InterpWrappedStpReal here. +! FUNCTION InterpolateWithSlope(InterpSlope, Ind, YAry) +! REAL(ReKi), INTENT(IN) :: InterpSlope +! INTEGER(IntKi), INTENT(IN ) :: Ind !< Misc/optimization variables +! REAL(SiKi), INTENT(IN) :: YAry(0:) +! REAL(ReKi) :: InterpolateWithSlope +! +! InterpolateWithSlope = ( YAry(Ind+1) - YAry(Ind) )*InterpSlope + YAry(Ind) +! +! END FUNCTION InterpolateWithSlope +! !---------------------------------------------------------------------------------------------------------------------------------- +! !> Use in conjunction with GetInterpolationSlope, to replace InterpWrappedStpReal here. +! FUNCTION InterpolateWithSlopeR(InterpSlope, Ind, YAry) +! REAL(ReKi), INTENT(IN) :: InterpSlope +! INTEGER(IntKi), INTENT(IN ) :: Ind !< Misc/optimization variables +! REAL(ReKi), INTENT(IN) :: YAry(0:) +! REAL(ReKi) :: InterpolateWithSlopeR +! +! InterpolateWithSlopeR = ( YAry(Ind+1) - YAry(Ind) )*InterpSlope + YAry(Ind) +! +! END FUNCTION InterpolateWithSlopeR !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) @@ -2646,7 +2561,8 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, INTEGER(IntKi) :: MemSubStat, NumFSX REAL(ReKi) :: theta1, theta2, dFdl(6), y_hat(3), z_hat(3), posMid(3), zetaMid, FSPt(3) INTEGER(IntKi) :: secStat - REAL(SiKi) :: FDynP, FV(3), FA(3), FAMCF(3) + INTEGER(IntKi) :: nodeInWater + REAL(SiKi) :: WaveElev1, WaveElev2, WaveElev, FDynP, FV(3), FA(3), FAMCF(3) LOGICAL :: Is1stElement ! Initialize errStat @@ -2673,126 +2589,12 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, END IF IF (p%WaveStMod > 0 .AND. p%WaveDisp /= 0) THEN ! Wave stretching enabled - pos1(3) = u%Mesh%Position(3,j) + u%Mesh%TranslationDisp(3,j) ! Use the current Z location. + pos1(3) = u%Mesh%Position(3,j) + u%Mesh%TranslationDisp(3,j) - p%MSL2SWL ! Use the current Z location. ELSE ! Wave stretching disabled - pos1(3) = u%Mesh%Position(3,j) ! We are intentionally using the undisplaced Z position of the node. + pos1(3) = u%Mesh%Position(3,j) - p%MSL2SWL ! We are intentionally using the undisplaced Z position of the node. END IF - - ! Compute the free surface elevation at the x/y position of all nodes - ! positionXY = (/pos1(1),pos1(2)/) - ! m%WaveElev1(j) = SeaSt_Interp_3D( Time, positionXY, p%WaveElev1, p%seast_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! IF (associated(p%WaveElev2)) THEN - ! m%WaveElev2(j) = SeaSt_Interp_3D( Time, positionXY, p%WaveElev2, p%seast_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%WaveElev(j) = m%WaveElev1(j) + m%WaveElev2(j) - ! ELSE - ! m%WaveElev(j) = m%WaveElev1(j) - ! END IF - - ! m%WaveElev1(j) = WaveField_GetWaveElev1(p%WaveField, Time, pos1, ErrStat2, ErrMsg2) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%WaveElev2(j) = WaveField_GetWaveElev2(p%WaveField, Time, pos1, ErrStat2, ErrMsg2) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%WaveElev( j) = m%WaveElev1(j) + m%WaveElev2(j) - - - ! IF (p%WaveStMod == 0) THEN ! No wave stretching - ! - ! IF ( pos1(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL - ! ! Use location to obtain interpolated values of kinematics - ! call SeaSt_Interp_Setup( Time, pos1, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%FV(:,j) = SeaSt_Interp_4D_Vec( p%WaveVel, m%seast_interp_m, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%FA(:,j) = SeaSt_Interp_4D_Vec( p%WaveAcc, m%seast_interp_m, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%FDynP(j) = SeaSt_Interp_4D ( p%WaveDynP, m%seast_interp_m, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%vrel(:,j) = m%FV(:,j) - u%Mesh%TranslationVel(:,j) - ! m%nodeInWater(j) = 1_IntKi - ! ELSE ! Node is above the SWL - ! m%FV(:,j) = 0.0 - ! m%FA(:,j) = 0.0 - ! m%FDynP(j) = 0.0 - ! m%vrel(:,j) = 0.0 - ! m%nodeInWater(j) = 0_IntKi - ! END IF - ! - ! ELSE ! Wave stretching enabled - ! - ! IF ( pos1(3) <= m%WaveElev(j)) THEN ! Node is submerged - ! - ! m%nodeInWater(j) = 1_IntKi - ! - ! IF (p%WaveStMod <3) THEN ! Vertical or extrapolated wave stretching - ! - ! IF ( pos1(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, pos1, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%FV(:,j) = SeaSt_Interp_4D_Vec( p%WaveVel, m%seast_interp_m, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%FA(:,j) = SeaSt_Interp_4D_Vec( p%WaveAcc, m%seast_interp_m, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%FDynP(j) = SeaSt_Interp_4D ( p%WaveDynP, m%seast_interp_m, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! - ! ELSE ! Node is above SWL - need wave stretching - ! - ! ! Vertical wave stretching - ! m%FV(:,j) = SeaSt_Interp_3D_vec( Time, positionXY, p%WaveVel0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%FA(:,j) = SeaSt_Interp_3D_vec( Time, positionXY, p%WaveAcc0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%FDynP(j) = SeaSt_Interp_3D ( Time, positionXY, p%WaveDynP0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! - ! ! Extrapoled wave stretching - ! IF (p%WaveStMod == 2) THEN - ! m%FV(:,j) = m%FV(:,j) + SeaSt_Interp_3D_vec( Time, positionXY, p%PWaveVel0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos1(3) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%FA(:,j) = m%FA(:,j) + SeaSt_Interp_3D_vec( Time, positionXY, p%PWaveAcc0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos1(3) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%FDynP(j) = m%FDynP(j) + SeaSt_Interp_3D ( Time, positionXY, p%PWaveDynP0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos1(3) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! 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 [-WtrDpth,m%WaveElev(j)] to [-WtrDpth,0] - ! pos1Prime = pos1 - ! pos1Prime(3) = WtrDpth*(WtrDpth+pos1(3))/(WtrDpth+m%WaveElev(j))-WtrDpth - ! - ! ! Obtain the wave-field variables by interpolation with the mapped position. - ! call SeaSt_Interp_Setup( Time, pos1Prime, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%FV(:,j) = SeaSt_Interp_4D_Vec( p%WaveVel, m%seast_interp_m, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%FA(:,j) = SeaSt_Interp_4D_Vec( p%WaveAcc, m%seast_interp_m, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%FDynP(j) = SeaSt_Interp_4D ( p%WaveDynP, m%seast_interp_m, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! - ! END IF - ! - ! m%vrel(:,j) = m%FV(:,j) - u%Mesh%TranslationVel(:,j) - ! - ! ELSE ! Node is out of water - zero-out all wave dynamics - ! - ! m%nodeInWater(j) = 0_IntKi - ! m%FV(:,j) = 0.0 - ! m%FA(:,j) = 0.0 - ! m%FDynP(j) = 0.0 - ! m%vrel(:,j) = 0.0 - ! - ! END IF ! If node is in or out of water - ! - ! END IF ! If wave stretching is on or off - + + ! Get the wave elevation and wave kinematics at each node CALL WaveField_GetWaveKin( p%WaveField, Time, pos1, m%nodeInWater(j), m%WaveElev1(j), m%WaveElev2(j), m%WaveElev(j), FDynP, FV, FA, FAMCF, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) m%FDynP(j) = REAL(FDynP,ReKi) @@ -2804,98 +2606,6 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, m%vrel(:,j) = ( m%FV(:,j) - u%Mesh%TranslationVel(:,j) ) * m%nodeInWater(j) END DO ! j = 1, p%NNodes - - ! Scaled fluid acceleration for the MacCamy-Fuchs model - ! IF ( ASSOCIATED(p%WaveAccMCF) ) THEN - ! DO im = 1,p%NMembers - ! IF ( p%Members(im)%PropMCF .AND. ( .NOT. p%Members(im)%PropPot ) ) THEN - ! DO i = 1,p%Members(im)%NElements+1 - ! j = p%Members(im)%NodeIndx(i) - ! - ! IF (p%WaveDisp == 0 ) THEN - ! ! use the initial X,Y location - ! pos1(1) = u%Mesh%Position(1,j) - ! pos1(2) = u%Mesh%Position(2,j) - ! ELSE - ! ! Use current X,Y location - ! pos1(1) = u%Mesh%TranslationDisp(1,j) + u%Mesh%Position(1,j) - ! pos1(2) = u%Mesh%TranslationDisp(2,j) + u%Mesh%Position(2,j) - ! END IF - ! - ! IF (p%WaveStMod > 0 .AND. p%WaveDisp /= 0) THEN ! Wave stretching enabled - ! pos1(3) = u%Mesh%Position(3,j) + u%Mesh%TranslationDisp(3,j) - p%MSL2SWL ! Use the current Z location. - ! ELSE ! Wave stretching disabled - ! pos1(3) = u%Mesh%Position(3,j) - p%MSL2SWL ! We are intentionally using the undisplaced Z position of the node. - ! END IF - ! - ! ! Compute the free surface elevation at the x/y position of all nodes - ! positionXY = (/pos1(1),pos1(2)/) - ! - ! IF (p%WaveStMod == 0) THEN ! No wave stretching - ! - ! IF ( pos1(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL - ! ! Use location to obtain interpolated values of kinematics - ! call SeaSt_Interp_Setup( Time, pos1, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%FAMCF(:,j) = SeaSt_Interp_4D_Vec( p%WaveAccMCF, m%seast_interp_m, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! ELSE ! Node is above the SWL - ! m%FAMCF(:,j) = 0.0 - ! END IF - ! - ! ELSE ! Wave stretching enabled - ! - ! IF ( pos1(3) <= m%WaveElev(j)) THEN ! Node is submerged - ! - ! IF (p%WaveStMod <3) THEN ! Vertical or extrapolated wave stretching - ! - ! IF ( pos1(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, pos1, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%FAMCF(:,j) = SeaSt_Interp_4D_Vec( p%WaveAccMCF, m%seast_interp_m, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! ELSE ! Node is above SWL - need wave stretching - ! - ! - ! ! Vertical wave stretching - ! m%FAMCF(:,j) = SeaSt_Interp_3D_vec( Time, positionXY, p%WaveAccMCF0, p%seast_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! - ! ! Extrapoled wave stretching - ! IF (p%WaveStMod == 2) THEN - ! m%FAMCF(:,j) = m%FAMCF(:,j) + SeaSt_Interp_3D_vec( Time, positionXY, p%PWaveAccMCF0, p%seast_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos1(3) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! 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 [-WtrDpth,m%WaveElev(j)] to [-WtrDpth,0] - ! pos1Prime = pos1 - ! pos1Prime(3) = WtrDpth*(WtrDpth+pos1(3))/(WtrDpth+m%WaveElev(j))-WtrDpth - ! - ! ! Obtain the wave-field variables by interpolation with the mapped position. - ! call SeaSt_Interp_Setup( Time, pos1Prime, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! m%FAMCF(:,j) = SeaSt_Interp_4D_Vec( p%WaveAccMCF, m%seast_interp_m, ErrStat2, ErrMsg2 ) - ! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! - ! END IF - ! - ! ELSE ! Node is out of water - zero-out all wave dynamics - ! - ! m%FAMCF(:,j) = 0.0 - ! - ! END IF ! If node is in or out of water - ! - ! END IF ! If wave stretching is on or off - ! - ! END DO - ! END IF - ! END DO - ! END IF ! ============================================================================================== ! Calculate instantaneous loads on each member except for the hydrodynamic loads on member ends. @@ -3338,88 +3048,13 @@ 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 dynamics at the free surface intersection - IF (p%WaveStMod <3) THEN ! Vertical or extrapolated stretching - - IF ( FSInt(3) <= 0.0_ReKi) THEN ! Intersection is below SWL - evaluate wave dynamics as usual - - ! Use location to obtain interpolated values of kinematics - CALL SeaSt_Interp_Setup( Time, FSInt, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FVFSInt = SeaSt_Interp_4D_Vec( p%WaveVel, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FAFSInt = SeaSt_Interp_4D_Vec( p%WaveAcc, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FDynPFSInt = SeaSt_Interp_4D ( p%WaveDynP, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSE ! Intersection is above SWL - need wave stretching - - ! Vertical wave stretching - FVFSInt = SeaSt_Interp_3D_vec( Time, FSInt(1:2), p%WaveVel0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FAFSInt = SeaSt_Interp_3D_vec( Time, FSInt(1:2), p%WaveAcc0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FDynPFSInt = SeaSt_Interp_3D ( Time, FSInt(1:2), p%WaveDynP0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Extrapolated wave stretching - IF (p%WaveStMod == 2) THEN - FVFSInt = FVFSInt + SeaSt_Interp_3D_vec( Time, FSInt(1:2), p%PWaveVel0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * FSInt(3) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FAFSInt = FAFSInt + SeaSt_Interp_3D_vec( Time, FSInt(1:2), p%PWaveAcc0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * FSInt(3) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FDynPFSInt = FDynPFSInt + SeaSt_Interp_3D ( Time, FSInt(1:2), p%PWaveDynP0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * FSInt(3) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - END IF - - ELSE ! Wheeler stretching - - ! Points on the free surface is always mapped back to z=0 of the unstretched wave field - ! Can evaluate the wave-field variables in the same way as vertical stretching - FVFSInt = SeaSt_Interp_3D_vec( Time, FSInt(1:2), p%WaveVel0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FAFSInt = SeaSt_Interp_3D_vec( Time, FSInt(1:2), p%WaveAcc0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FDynPFSInt = SeaSt_Interp_3D( Time, FSInt(1:2), p%WaveDynP0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - END IF - - + CALL WaveField_GetWaveKin( p%WaveField, Time, FSInt, 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) + FAFSInt = REAL(FA, ReKi) IF ( mem%PropMCF .AND. ( .NOT. mem%PropPot ) ) THEN - IF (p%WaveStMod <3) THEN ! Vertical or extrapolated stretching - - IF ( FSInt(3) <= 0.0_ReKi) THEN ! Intersection is below SWL - evaluate wave dynamics as usual - - ! Use location to obtain interpolated values of kinematics - CALL SeaSt_Interp_Setup( Time, FSInt, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FAMCFFSInt = SeaSt_Interp_4D_Vec( p%WaveAccMCF, m%seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ELSE ! Intersection is above SWL - need wave stretching - - ! Vertical wave stretching - FAMCFFSInt = SeaSt_Interp_3D_vec( Time, FSInt(1:2), p%WaveAccMCF0, p%seast_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Extrapolated wave stretching - IF (p%WaveStMod == 2) THEN - FAMCFFSInt = FAMCFFSInt + SeaSt_Interp_3D_vec( Time, FSInt(1:2), p%PWaveAccMCF0, p%seast_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * FSInt(3) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - END IF - - ELSE ! Wheeler stretching - - ! Points on the free surface is always mapped back to z=0 of the unstretched wave field - ! Can evaluate the wave-field variables in the same way as vertical stretching - FAMCFFSInt = SeaSt_Interp_3D_vec( Time, FSInt(1:2), p%WaveAccMCF0, p%seast_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF + FAMCFFSInt = REAL(FAMCF,ReKi) END IF ! Viscous drag: @@ -3955,13 +3590,10 @@ SUBROUTINE GetTotalWaveElev( Time, pos, Zeta, ErrStat, ErrMsg ) CHARACTER(ErrMsgLen) :: errMsg2 ErrStat = ErrID_None ErrMsg = "" - Zeta = SeaSt_Interp_3D( Time, pos(1:2), p%WaveElev1, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + + Zeta = WaveField_GetTotalWaveElev( p%WaveField, Time, pos, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (associated(p%WaveElev2)) THEN - Zeta = Zeta + SeaSt_Interp_3D( Time, pos(1:2), p%WaveElev2, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - + END SUBROUTINE GetTotalWaveElev SUBROUTINE GetFreeSurfaceNormal( Time, pos, r, n, ErrStat, ErrMsg) @@ -3971,29 +3603,14 @@ SUBROUTINE GetFreeSurfaceNormal( Time, pos, r, n, ErrStat, ErrMsg) 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(ReKi) :: r1,ZetaP,ZetaM,dZetadx,dZetady CHARACTER(*), PARAMETER :: RoutineName = 'GetFreeSurfaceNormal' INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 ErrStat = ErrID_None ErrMsg = "" - r1 = MAX(r,1.0e-6) ! In case r is zero - - CALL GetTotalWaveElev( Time, (/pos(1)+r1,pos(2)/), ZetaP, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL GetTotalWaveElev( Time, (/pos(1)-r1,pos(2)/), ZetaM, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - dZetadx = (ZetaP-ZetaM)/(2.0_ReKi*r1) - - CALL GetTotalWaveElev( Time, (/pos(1),pos(2)+r1/), ZetaP, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL GetTotalWaveElev( Time, (/pos(1),pos(2)-r1/), ZetaM, ErrStat2, ErrMsg2 ) + CALL WaveField_GetWaveNormal( p%WaveField, Time, pos, r, n, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - dZetady = (ZetaP-ZetaM)/(2.0_ReKi*r1) - - n = (/-dZetadx,-dZetady,1.0_ReKi/) - n = n / SQRT(Dot_Product(n,n)) END SUBROUTINE GetFreeSurfaceNormal @@ -4566,10 +4183,10 @@ SUBROUTINE Morison_UpdateDiscState( Time, u, p, x, xd, z, OtherState, m, errStat INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: errMsg !< Error message if errStat /= ErrID_None INTEGER(IntKi) :: J + INTEGER(IntKi) :: nodeInWater REAL(ReKi) :: WtrDpth - REAL(ReKi) :: pos(3), posPrime(3), positionXY(2) - REAL(SiKi) :: WaveElev, WaveElev1, WaveElev2 - REAL(ReKi) :: vrel(3), FV(3), vmag, vmagf + REAL(ReKi) :: pos(3), vrel(3), FV(3), vmag, vmagf + REAL(SiKi) :: FVTmp(3) INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UpdateDiscState' @@ -4582,86 +4199,39 @@ SUBROUTINE Morison_UpdateDiscState( Time, u, p, x, xd, z, OtherState, m, errStat WtrDpth = p%WtrDpth + p%MSL2SWL ! Update state of the relative normal velocity high-pass filter at each joint - DO j = 1, p%NJoints + DO J = 1, p%NJoints + ! Get joint position IF (p%WaveDisp == 0 ) THEN ! use the initial X,Y location - pos(1) = u%Mesh%Position(1,j) - pos(2) = u%Mesh%Position(2,j) + pos(1) = u%Mesh%Position(1,J) + pos(2) = u%Mesh%Position(2,J) ELSE ! Use current X,Y location - pos(1) = u%Mesh%TranslationDisp(1,j) + u%Mesh%Position(1,j) - pos(2) = u%Mesh%TranslationDisp(2,j) + u%Mesh%Position(2,j) + pos(1) = u%Mesh%TranslationDisp(1,J) + u%Mesh%Position(1,J) + pos(2) = u%Mesh%TranslationDisp(2,J) + u%Mesh%Position(2,J) END IF IF (p%WaveStMod > 0 .AND. p%WaveDisp /= 0) THEN ! Wave stretching enabled - pos(3) = u%Mesh%Position(3,j) + u%Mesh%TranslationDisp(3,j) - p%MSL2SWL ! Use the current Z location. + pos(3) = u%Mesh%Position(3,J) + u%Mesh%TranslationDisp(3,J) - p%MSL2SWL ! Use the current Z location. ELSE ! Wave stretching disabled - pos(3) = u%Mesh%Position(3,j) - p%MSL2SWL ! We are intentionally using the undisplaced Z position of the node. - END IF - ! Compute the free surface elevation at the x/y position of the joint - positionXY = (/pos(1),pos(2)/) - WaveElev1 = SeaSt_Interp_3D( Time, positionXY, p%WaveElev1, p%seast_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (associated(p%WaveElev2)) THEN - WaveElev2 = SeaSt_Interp_3D( Time, positionXY, p%WaveElev2, p%seast_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveElev = WaveElev1 + WaveElev2 - ELSE - WaveElev = WaveElev1 + pos(3) = u%Mesh%Position(3,J) - p%MSL2SWL ! We are intentionally using the undisplaced Z position of the node. END IF - ! Compute fluid and relative velocity at the joint - IF (p%WaveStMod == 0) THEN ! No wave stretching - IF ( pos(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL - ! Use location to obtain interpolated values of kinematics - call SeaSt_Interp_Setup( Time, pos, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV = SeaSt_Interp_4D_Vec( p%WaveVel, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - vrel = FV - u%Mesh%TranslationVel(:,j) - ELSE ! Node is above the SWL - vrel = 0.0_ReKi - END IF - ELSE ! Wave stretching enabled - IF ( pos(3) <= WaveElev ) THEN ! Node is submerged - IF ( p%WaveStMod < 3 ) THEN ! Vertical or extrapolated wave stretching - IF ( pos(3) <= 0.0_ReKi) 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, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV = SeaSt_Interp_4D_Vec( p%WaveVel, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSE ! Node is above SWL - need wave stretching - ! Vertical wave stretching - FV = SeaSt_Interp_3D_vec( Time, positionXY, p%WaveVel0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! Extrapoled wave stretching - IF (p%WaveStMod == 2) THEN - FV = FV + SeaSt_Interp_3D_vec( Time, positionXY, p%PWaveVel0, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - 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 [-WtrDpth,WaveElev] to [-WtrDpth,0] - posPrime = pos - posPrime(3) = WtrDpth*(WtrDpth+pos(3))/(WtrDpth+WaveElev)-WtrDpth - ! Obtain the wave-field variables by interpolation with the mapped position. - call SeaSt_Interp_Setup( Time, posPrime, p%seast_interp_p, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV = SeaSt_Interp_4D_Vec( p%WaveVel, m%seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - vrel = FV - u%Mesh%TranslationVel(:,j) - ELSE ! Node is out of water - zero-out all wave dynamics - vrel = 0.0_ReKi - END IF ! If node is in or out of water - END IF ! If wave stretching is on or off + + ! Get fluid velocity at the joint + CALL WaveField_GetWaveVel( p%WaveField, Time, pos, nodeInWater, FVTmp, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FV = REAL(FVTmp, ReKi) + vrel = ( FV - u%Mesh%TranslationVel(:,J) ) * nodeInWater + ! Compute the dot product of the relative velocity vector with the directional Area of the Joint vmag = vrel(1)*p%An_End(1,J) + vrel(2)*p%An_End(2,J) + vrel(3)*p%An_End(3,J) ! High-pass filtering vmagf = p%VRelNFiltConst(J) * (vmag + xd%V_rel_n_FiltStat(J)) ! Update relative normal velocity filter state for joint J xd%V_rel_n_FiltStat(J) = vmagf-vmag - END DO ! j = 1, p%NJoints + + END DO ! J = 1, p%NJoints + END SUBROUTINE Morison_UpdateDiscState !---------------------------------------------------------------------------------------------------------------------------------- END MODULE Morison diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index d088280123..a12a4a0cde 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -96,8 +96,8 @@ typedef ^ ^ ReKi typedef ^ Morison_MemberType INTEGER NodeIndx {:} - - "Index of each of the member's nodes in the master node list" - typedef ^ ^ INTEGER MemberID - - - "User-supplied integer ID for this member" - typedef ^ ^ INTEGER NElements - - - "number of elements in this member" - -typedef ^ ^ ReKi RefLength - - - "the reference total length for this member" m -typedef ^ ^ ReKi cosPhi_ref - - - "the reference cosine of the inclination angle of the member" - +typedef ^ ^ ReKi RefLength - - - "the reference total length for this member" m +typedef ^ ^ ReKi cosPhi_ref - - - "the reference cosine of the inclination angle of the member" - typedef ^ ^ ReKi dl - - - "the reference element length for this member (may be less than MDivSize to achieve uniform element lengths)" m typedef ^ ^ ReKi k {3} - - "unit vector of the member's orientation (may be changed to per-element once additional flexibility is accounted for in HydroDyn)" m typedef ^ ^ ReKi kkt {3}{3} - - "matrix of matmul(k_hat, transpose(k_hat)" - @@ -213,10 +213,10 @@ typedef ^ Morison_MOutput INTEGER typedef ^ Morison_MOutput INTEGER NOutLoc - - - "The number of requested output locations" - typedef ^ Morison_MOutput ReKi NodeLocs {:} - - "Normalized locations along user-specified member for the outputs" - typedef ^ Morison_MOutput INTEGER MemberIDIndx - - - "Index for member in the master list" - -typedef ^ Morison_MOutput INTEGER MeshIndx1 {:} - - "Index of node in Mesh for the start of the member element" - -typedef ^ Morison_MOutput INTEGER MeshIndx2 {:} - - "Index of node in Mesh for the end of the member element" - -typedef ^ Morison_MOutput INTEGER MemberIndx1 {:} - - "Index of Member nodes for the start of the member element" - -typedef ^ Morison_MOutput INTEGER MemberIndx2 {:} - - "Index of Member nodes for the end of the member element" - +typedef ^ Morison_MOutput INTEGER MeshIndx1 {:} - - "Index of node in Mesh for the start of the member element" - +typedef ^ Morison_MOutput INTEGER MeshIndx2 {:} - - "Index of node in Mesh for the end of the member element" - +typedef ^ Morison_MOutput INTEGER MemberIndx1 {:} - - "Index of Member nodes for the start of the member element" - +typedef ^ Morison_MOutput INTEGER MemberIndx2 {:} - - "Index of Member nodes for the end of the member element" - typedef ^ Morison_MOutput ReKi s {:} - - "Linear interpolation factor between node1 and node2 for the output location" - typedef ^ Morison_JOutput INTEGER JointID - - - "Joint ID for the requested output" - typedef ^ ^ INTEGER JointIDIndx - - - "Joint index in the master list" - @@ -273,21 +273,9 @@ typedef ^ ^ CHARACTER(C typedef ^ ^ INTEGER NumOuts - - - "" - typedef ^ ^ INTEGER UnSum - - - "" - typedef ^ ^ INTEGER NStepWave - - - "" - -typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation (points to SeaState module data)" - -typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation (points to SeaState module data)" - -typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "(points to SeaState module data)" - -typedef ^ ^ SiKi WaveAccMCF {*}{*}{*}{*}{*} - - "(points to SeaState module data)" - -typedef ^ ^ SiKi WaveTime {*} - - "(points to SeaState module data)" - -typedef ^ ^ SiKi WaveDynP {*}{*}{*}{*} - - "(points to SeaState module data)" - -typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "(points to SeaState module data)" - -typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "(points to SeaState module data)" - -typedef ^ ^ SiKi PWaveAccMCF0 {*}{*}{*}{*} - - "(points to SeaState module data)" - -typedef ^ ^ SiKi PWaveDynP0 {*}{*}{*} - - "(points to SeaState module data)" - -typedef ^ ^ SiKi PWaveVel0 {*}{*}{*}{*} - - "(points to SeaState module data)" - -typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - typedef ^ ^ INTEGER WaveStMod - - - "" - typedef ^ ^ SiKi MCFD - - - "Diameter of the MacCamy-Fuchs member." - -typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - # # # Define outputs from the initialization routine here: @@ -318,95 +306,69 @@ typedef ^ OtherStateType IntKi # ..... 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 ReKi F_D {:}{:} - - "Member-based (side-effects) Nodal viscous drag loads at time t" - -#typedef ^ ^ ReKi F_I {:}{:} - - "Member-based (side-effects) Nodal inertial loads at time t" - -#typedef ^ ^ ReKi F_A {:}{:} - - "Member-based (side-effects) Nodal added mass loads at time t" - -#typedef ^ ^ ReKi F_B {:}{:} - - "Member-based (side-effects) Nodal buoyancy loads" - -#typedef ^ ^ ReKi F_BF {:}{:} - - "Member-based (side-effects) Nodal flooded ballast weight/buoyancy loads" - -#typedef ^ ^ ReKi F_If {:}{:} - - "Member-based (side-effects) Nodal flooded ballast inertia loads" - -#typedef ^ ^ ReKi F_WMG {:}{:} - - "Member-based (side-effects) Nodal marine growth weight loads" - -#typedef ^ ^ ReKi F_IMG {:}{:} - - "Member-based (side-effects) Nodal marine growth inertia loads" - -#typedef ^ ^ ReKi F_DP {:}{:} - - "Lumped dynamic pressure loads at time t, which may not correspond to the WaveTime array of times" - typedef ^ MiscVarType ReKi FV {:}{:} - - "Fluid velocity at line element node at time t, which may not correspond to the WaveTime array of times" - typedef ^ ^ ReKi FA {:}{:} - - "Fluid acceleration at line element node at time t, which may not correspond to the WaveTime array of times" - typedef ^ ^ ReKi FAMCF {:}{:} - - "Fluid acceleration at line element node at time t, which may not correspond to the WaveTime array of times" - typedef ^ ^ ReKi FDynP {:} - - "Fluid dynamic pressure at line element node at time t, which may not correspond to the WaveTime array of times" - typedef ^ ^ SiKi WaveElev {:} - - "Total wave elevation" m -typedef ^ ^ SiKi WaveElev1 {:} - - "First order wave elevation" m -typedef ^ ^ SiKi WaveElev2 {:} - - "Second order wave elevation" m +typedef ^ ^ SiKi WaveElev1 {:} - - "First order wave elevation" m +typedef ^ ^ SiKi WaveElev2 {:} - - "Second order wave elevation" m typedef ^ ^ ReKi vrel {:}{:} - - "velocity of structural node relative to the water" m/s^2 -typedef ^ ^ INTEGER nodeInWater {:} - - "Logical flag indicating if the node at the given time step is in the water, and hence needs to have hydrodynamic forces calculated" - -typedef ^ ^ Morison_MemberLoads memberLoads {:} - - "Array (NMembers long) of member-based side-effects load contributions" - -typedef ^ ^ ReKi F_B_End {:}{:} - - "" - +typedef ^ ^ INTEGER nodeInWater {:} - - "Logical flag indicating if the node at the given time step is in the water, and hence needs to have hydrodynamic forces calculated" - +typedef ^ ^ Morison_MemberLoads memberLoads {:} - - "Array (NMembers long) of member-based side-effects load contributions" - +typedef ^ ^ ReKi F_B_End {:}{:} - - "" - typedef ^ ^ ReKi F_D_End {:}{:} - - "Lumped viscous drag loads at time t, which may not correspond to the WaveTime array of times" - typedef ^ ^ ReKi F_I_End {:}{:} - - "Lumped intertia loads at time t, which may not correspond to the WaveTime array of times" - typedef ^ ^ ReKi F_IMG_End {:}{:} - - "Joint marine growth intertia loads at time t, which may not correspond to the WaveTime array of times" - -typedef ^ ^ ReKi F_A_End {:}{:} - - "Lumped added mass loads at time t, which may not correspond to the WaveTime array of times" - -typedef ^ ^ ReKi F_BF_End {:}{:} - - "" - -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 ^ ^ INTEGER LastIndWave - - - "Last time index used in the wave kinematics arrays" - -typedef ^ ^ SeaSt_Interp_MiscVarType SeaSt_Interp_m - - - "misc var information from the SeaState Interpolation module" - +typedef ^ ^ ReKi F_A_End {:}{:} - - "Lumped added mass loads at time t, which may not correspond to the WaveTime array of times" - +typedef ^ ^ ReKi F_BF_End {:}{:} - - "" - +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 ^ ^ INTEGER LastIndWave - - - "Last time index used in the wave kinematics arrays" - # ..... 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 DbKi DT - - - "Time step for continuous state integration & discrete state update" (sec) -typedef ^ ^ ReKi Gravity - - - "Gravity (scalar, positive-valued)" m/s^2 -typedef ^ ^ ReKi WtrDens - - - "Water density" kg/m^3 -typedef ^ ^ ReKi WtrDpth - - - "Water depth (positive-valued)" m -typedef ^ ^ ReKi MSL2SWL - - - "Mean Sea Level to Still Water Level offset" m -typedef ^ ^ INTEGER WaveDisp - - - "Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) " - -typedef ^ ^ INTEGER AMMod - - - "Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState]" - -typedef ^ ^ INTEGER NMembers - - - "number of members" - -typedef ^ ^ Morison_MemberType Members {:} - - "Array of Morison members used during simulation" - -typedef ^ ^ INTEGER NNodes - - - "" - -typedef ^ ^ INTEGER NJoints - - - "Number of user-specified joints" - -typedef ^ ^ ReKi I_MG_End {:}{:}{:} - - "Inertial matrix associated with marine growth mass at joint" - -typedef ^ ^ ReKi An_End {:}{:} - - "directional area vector of each joint" m^2 -typedef ^ ^ ReKi DragConst_End {:} - - "" - -typedef ^ ^ ReKi VRelNFiltConst {:} - - "" - -typedef ^ ^ IntKi DragMod_End {:} - - "" - -typedef ^ ^ ReKi DragLoFSc_End {:} - - "" - -typedef ^ ^ ReKi F_WMG_End {:}{:} - - "Joint marine growth weight loads, constant for all t" N -typedef ^ ^ ReKi DP_Const_End {:}{:} - - "Constant part of Joint dynamic pressure term" N -typedef ^ ^ ReKi Mass_MG_End {:} - - "Joint marine growth mass" kg -typedef ^ ^ ReKi AM_End {:}{:}{:} - - "3x3 Joint added mass matrix, constant for all t" N -typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation (points to SeaState module data)" m -typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation (points to SeaState module data)" m -typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "(points to SeaState module data)" - -typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "(points to SeaState module data)" - -typedef ^ ^ SiKi WaveAccMCF {*}{*}{*}{*}{*} - - "(points to SeaState module data)" - -typedef ^ ^ SiKi WaveDynP {*}{*}{*}{*} - - "(points to SeaState module data)" - -typedef ^ ^ SiKi WaveVel0 {:}{:}{:}{:} - - "" - -typedef ^ ^ SiKi WaveAcc0 {:}{:}{:}{:} - - "" - -typedef ^ ^ SiKi WaveAccMCF0 {:}{:}{:}{:} - - "" - -typedef ^ ^ SiKi WaveDynP0 {:}{:}{:} - - "" - -typedef ^ ^ SiKi WaveTime {*} - - "Times for which the wave kinematics are pre-computed (points to SeaState module data)" s -typedef ^ ^ SiKi PWaveVel0 {*}{*}{*}{*} - - "(points to SeaState module data)" - -typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "(points to SeaState module data)" - -typedef ^ ^ SiKi PWaveAccMCF0 {*}{*}{*}{*} - - "(points to SeaState module data)" - -typedef ^ ^ SiKi PWaveDynP0 {*}{*}{*} - - "(points to SeaState module data)" - -typedef ^ ^ INTEGER NStepWave - - - "" - -typedef ^ ^ INTEGER NMOutputs - - - "" - -typedef ^ ^ Morison_MOutput MOutLst {:} - - "" - -typedef ^ ^ INTEGER NJOutputs - - - "" - -typedef ^ ^ Morison_JOutput JOutLst {:} - - "" - -typedef ^ ^ OutParmType OutParam {:} - - "" - -typedef ^ ^ INTEGER NumOuts - - - "" - -typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - -typedef ^ ^ INTEGER WaveStMod - - - "" - -typedef ^ ^ SeaSt_WaveFieldType WaveField - - - "SeaState wave field" - +typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" (sec) +typedef ^ ^ ReKi Gravity - - - "Gravity (scalar, positive-valued)" m/s^2 +typedef ^ ^ ReKi WtrDens - - - "Water density" kg/m^3 +typedef ^ ^ ReKi WtrDpth - - - "Water depth (positive-valued)" m +typedef ^ ^ ReKi MSL2SWL - - - "Mean Sea Level to Still Water Level offset" m +typedef ^ ^ INTEGER WaveDisp - - - "Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) " - +typedef ^ ^ INTEGER AMMod - - - "Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState]" - +typedef ^ ^ INTEGER NMembers - - - "number of members" - +typedef ^ ^ Morison_MemberType Members {:} - - "Array of Morison members used during simulation" - +typedef ^ ^ INTEGER NNodes - - - "" - +typedef ^ ^ INTEGER NJoints - - - "Number of user-specified joints" - +typedef ^ ^ ReKi I_MG_End {:}{:}{:} - - "Inertial matrix associated with marine growth mass at joint" - +typedef ^ ^ ReKi An_End {:}{:} - - "directional area vector of each joint" m^2 +typedef ^ ^ ReKi DragConst_End {:} - - "" - +typedef ^ ^ ReKi VRelNFiltConst {:} - - "" - +typedef ^ ^ IntKi DragMod_End {:} - - "" - +typedef ^ ^ ReKi DragLoFSc_End {:} - - "" - +typedef ^ ^ ReKi F_WMG_End {:}{:} - - "Joint marine growth weight loads, constant for all t" N +typedef ^ ^ ReKi DP_Const_End {:}{:} - - "Constant part of Joint dynamic pressure term" N +typedef ^ ^ ReKi Mass_MG_End {:} - - "Joint marine growth mass" kg +typedef ^ ^ ReKi AM_End {:}{:}{:} - - "3x3 Joint added mass matrix, constant for all t" N +typedef ^ ^ INTEGER NStepWave - - - "" - +typedef ^ ^ INTEGER NMOutputs - - - "" - +typedef ^ ^ Morison_MOutput MOutLst {:} - - "" - +typedef ^ ^ INTEGER NJOutputs - - - "" - +typedef ^ ^ Morison_JOutput JOutLst {:} - - "" - +typedef ^ ^ OutParmType OutParam {:} - - "" - +typedef ^ ^ INTEGER NumOuts - - - "" - +typedef ^ ^ INTEGER WaveStMod - - - "" - +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "SeaState wave field" - # # # ..... Inputs .................................................................................................................... # Define inputs that are contained on the mesh here: # -typedef ^ InputType MeshType Mesh - - - "Kinematics of each node input mesh" - +typedef ^ InputType MeshType Mesh - - - "Kinematics of each node input mesh" - # # # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: -typedef ^ OutputType MeshType Mesh - - - "Loads on each node output mesh" - -typedef ^ ^ ReKi WriteOutput {:} - - "" - +typedef ^ OutputType MeshType Mesh - - - "Loads on each node output mesh" - +typedef ^ ^ ReKi WriteOutput {:} - - "" - diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 153bc8df5e..ac212b7386 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -336,18 +336,6 @@ MODULE Morison_Types INTEGER(IntKi) :: NumOuts !< [-] INTEGER(IntKi) :: UnSum !< [-] INTEGER(IntKi) :: NStepWave !< [-] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAccMCF => NULL() !< (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: WaveDynP => NULL() !< (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAccMCF0 => NULL() !< (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: PWaveDynP0 => NULL() !< (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveVel0 => NULL() !< (points to SeaState module data) [-] - TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] INTEGER(IntKi) :: WaveStMod !< [-] REAL(SiKi) :: MCFD !< Diameter of the MacCamy-Fuchs member. [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] @@ -400,7 +388,6 @@ 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] INTEGER(IntKi) :: LastIndWave !< Last time index used in the wave kinematics arrays [-] - TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m !< misc var information from the SeaState Interpolation module [-] END TYPE Morison_MiscVarType ! ======================= ! ========= Morison_ParameterType ======= @@ -426,21 +413,6 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DP_Const_End !< Constant part of Joint dynamic pressure term [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Mass_MG_End !< Joint marine growth mass [kg] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AM_End !< 3x3 Joint added mass matrix, constant for all t [N] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation (points to SeaState module data) [m] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation (points to SeaState module data) [m] - REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAccMCF => NULL() !< (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: WaveDynP => NULL() !< (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WaveVel0 !< [-] - REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WaveAcc0 !< [-] - REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WaveAccMCF0 !< [-] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveDynP0 !< [-] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Times for which the wave kinematics are pre-computed (points to SeaState module data) [s] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveVel0 => NULL() !< (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAccMCF0 => NULL() !< (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: PWaveDynP0 => NULL() !< (points to SeaState module data) [-] INTEGER(IntKi) :: NStepWave !< [-] INTEGER(IntKi) :: NMOutputs !< [-] TYPE(Morison_MOutput) , DIMENSION(:), ALLOCATABLE :: MOutLst !< [-] @@ -448,9 +420,8 @@ MODULE Morison_Types TYPE(Morison_JOutput) , DIMENSION(:), ALLOCATABLE :: JOutLst !< [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] INTEGER(IntKi) :: NumOuts !< [-] - TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] INTEGER(IntKi) :: WaveStMod !< [-] - TYPE(SeaSt_WaveFieldType) :: WaveField !< SeaState wave field [-] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< SeaState wave field [-] END TYPE Morison_ParameterType ! ======================= ! ========= Morison_InputType ======= @@ -6242,10 +6213,6 @@ SUBROUTINE Morison_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyInitInput' @@ -6477,20 +6444,6 @@ SUBROUTINE Morison_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%NumOuts = SrcInitInputData%NumOuts DstInitInputData%UnSum = SrcInitInputData%UnSum DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 - DstInitInputData%WaveElev2 => SrcInitInputData%WaveElev2 - DstInitInputData%WaveAcc => SrcInitInputData%WaveAcc - DstInitInputData%WaveAccMCF => SrcInitInputData%WaveAccMCF - DstInitInputData%WaveTime => SrcInitInputData%WaveTime - DstInitInputData%WaveDynP => SrcInitInputData%WaveDynP - DstInitInputData%WaveVel => SrcInitInputData%WaveVel - DstInitInputData%PWaveAcc0 => SrcInitInputData%PWaveAcc0 - DstInitInputData%PWaveAccMCF0 => SrcInitInputData%PWaveAccMCF0 - DstInitInputData%PWaveDynP0 => SrcInitInputData%PWaveDynP0 - DstInitInputData%PWaveVel0 => SrcInitInputData%PWaveVel0 - CALL SeaSt_Interp_CopyParam( SrcInitInputData%SeaSt_Interp_p, DstInitInputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod DstInitInputData%MCFD = SrcInitInputData%MCFD DstInitInputData%WaveField => SrcInitInputData%WaveField @@ -6589,19 +6542,6 @@ SUBROUTINE Morison_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) IF (ALLOCATED(InitInputData%OutList)) THEN DEALLOCATE(InitInputData%OutList) ENDIF -NULLIFY(InitInputData%WaveElev1) -NULLIFY(InitInputData%WaveElev2) -NULLIFY(InitInputData%WaveAcc) -NULLIFY(InitInputData%WaveAccMCF) -NULLIFY(InitInputData%WaveTime) -NULLIFY(InitInputData%WaveDynP) -NULLIFY(InitInputData%WaveVel) -NULLIFY(InitInputData%PWaveAcc0) -NULLIFY(InitInputData%PWaveAccMCF0) -NULLIFY(InitInputData%PWaveDynP0) -NULLIFY(InitInputData%PWaveVel0) - CALL SeaSt_Interp_DestroyParam( InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) NULLIFY(InitInputData%WaveField) END SUBROUTINE Morison_DestroyInitInput @@ -6936,23 +6876,6 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 1 ! NumOuts Int_BufSz = Int_BufSz + 1 ! UnSum Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_p: size of buffers for each call to pack subtype - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SeaSt_Interp_p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SeaSt_Interp_p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SeaSt_Interp_p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF Int_BufSz = Int_BufSz + 1 ! WaveStMod Re_BufSz = Re_BufSz + 1 ! MCFD IF ( Re_BufSz .GT. 0 ) THEN @@ -7524,34 +7447,6 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%NStepWave Int_Xferred = Int_Xferred + 1 - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF IntKiBuf(Int_Xferred) = InData%WaveStMod Int_Xferred = Int_Xferred + 1 ReKiBuf(Re_Xferred) = InData%MCFD @@ -7572,10 +7467,6 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackInitInput' @@ -8299,57 +8190,6 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Xferred = Int_Xferred + 1 OutData%NStepWave = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - NULLIFY(OutData%WaveElev1) - NULLIFY(OutData%WaveElev2) - NULLIFY(OutData%WaveAcc) - NULLIFY(OutData%WaveAccMCF) - NULLIFY(OutData%WaveTime) - NULLIFY(OutData%WaveDynP) - NULLIFY(OutData%WaveVel) - NULLIFY(OutData%PWaveAcc0) - NULLIFY(OutData%PWaveAccMCF0) - NULLIFY(OutData%PWaveDynP0) - NULLIFY(OutData%PWaveVel0) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_Interp_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) OutData%WaveStMod = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%MCFD = REAL(ReKiBuf(Re_Xferred), SiKi) @@ -9418,9 +9258,6 @@ SUBROUTINE Morison_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg DstMiscData%V_rel_n_HiPass = SrcMiscData%V_rel_n_HiPass ENDIF DstMiscData%LastIndWave = SrcMiscData%LastIndWave - CALL SeaSt_Interp_CopyMisc( SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE Morison_CopyMisc SUBROUTINE Morison_DestroyMisc( MiscData, ErrStat, ErrMsg ) @@ -9494,8 +9331,6 @@ SUBROUTINE Morison_DestroyMisc( MiscData, ErrStat, ErrMsg ) IF (ALLOCATED(MiscData%V_rel_n_HiPass)) THEN DEALLOCATE(MiscData%V_rel_n_HiPass) ENDIF - CALL SeaSt_Interp_DestroyMisc( MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Morison_DestroyMisc SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -9643,23 +9478,6 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Re_BufSz = Re_BufSz + SIZE(InData%V_rel_n_HiPass) ! V_rel_n_HiPass END IF Int_BufSz = Int_BufSz + 1 ! LastIndWave - Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_m: size of buffers for each call to pack subtype - CALL SeaSt_Interp_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_m, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt_Interp_m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SeaSt_Interp_m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SeaSt_Interp_m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SeaSt_Interp_m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -10035,34 +9853,6 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg END IF IntKiBuf(Int_Xferred) = InData%LastIndWave Int_Xferred = Int_Xferred + 1 - CALL SeaSt_Interp_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_m, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF END SUBROUTINE Morison_PackMisc SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -10507,46 +10297,6 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err END IF OutData%LastIndWave = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_Interp_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%SeaSt_Interp_m, ErrStat2, ErrMsg2 ) ! SeaSt_Interp_m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE Morison_UnPackMisc SUBROUTINE Morison_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -10560,8 +10310,6 @@ SUBROUTINE Morison_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Err INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyParam' @@ -10728,87 +10476,6 @@ SUBROUTINE Morison_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Err END IF DstParamData%AM_End = SrcParamData%AM_End ENDIF - DstParamData%WaveElev1 => SrcParamData%WaveElev1 - DstParamData%WaveElev2 => SrcParamData%WaveElev2 - DstParamData%WaveVel => SrcParamData%WaveVel - DstParamData%WaveAcc => SrcParamData%WaveAcc - DstParamData%WaveAccMCF => SrcParamData%WaveAccMCF - DstParamData%WaveDynP => SrcParamData%WaveDynP -IF (ALLOCATED(SrcParamData%WaveVel0)) THEN - i1_l = LBOUND(SrcParamData%WaveVel0,1) - i1_u = UBOUND(SrcParamData%WaveVel0,1) - i2_l = LBOUND(SrcParamData%WaveVel0,2) - i2_u = UBOUND(SrcParamData%WaveVel0,2) - i3_l = LBOUND(SrcParamData%WaveVel0,3) - i3_u = UBOUND(SrcParamData%WaveVel0,3) - i4_l = LBOUND(SrcParamData%WaveVel0,4) - i4_u = UBOUND(SrcParamData%WaveVel0,4) - IF (.NOT. ALLOCATED(DstParamData%WaveVel0)) THEN - ALLOCATE(DstParamData%WaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveVel0 = SrcParamData%WaveVel0 -ENDIF -IF (ALLOCATED(SrcParamData%WaveAcc0)) THEN - i1_l = LBOUND(SrcParamData%WaveAcc0,1) - i1_u = UBOUND(SrcParamData%WaveAcc0,1) - i2_l = LBOUND(SrcParamData%WaveAcc0,2) - i2_u = UBOUND(SrcParamData%WaveAcc0,2) - i3_l = LBOUND(SrcParamData%WaveAcc0,3) - i3_u = UBOUND(SrcParamData%WaveAcc0,3) - i4_l = LBOUND(SrcParamData%WaveAcc0,4) - i4_u = UBOUND(SrcParamData%WaveAcc0,4) - IF (.NOT. ALLOCATED(DstParamData%WaveAcc0)) THEN - ALLOCATE(DstParamData%WaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveAcc0 = SrcParamData%WaveAcc0 -ENDIF -IF (ALLOCATED(SrcParamData%WaveAccMCF0)) THEN - i1_l = LBOUND(SrcParamData%WaveAccMCF0,1) - i1_u = UBOUND(SrcParamData%WaveAccMCF0,1) - i2_l = LBOUND(SrcParamData%WaveAccMCF0,2) - i2_u = UBOUND(SrcParamData%WaveAccMCF0,2) - i3_l = LBOUND(SrcParamData%WaveAccMCF0,3) - i3_u = UBOUND(SrcParamData%WaveAccMCF0,3) - i4_l = LBOUND(SrcParamData%WaveAccMCF0,4) - i4_u = UBOUND(SrcParamData%WaveAccMCF0,4) - IF (.NOT. ALLOCATED(DstParamData%WaveAccMCF0)) THEN - ALLOCATE(DstParamData%WaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveAccMCF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveAccMCF0 = SrcParamData%WaveAccMCF0 -ENDIF -IF (ALLOCATED(SrcParamData%WaveDynP0)) THEN - i1_l = LBOUND(SrcParamData%WaveDynP0,1) - i1_u = UBOUND(SrcParamData%WaveDynP0,1) - i2_l = LBOUND(SrcParamData%WaveDynP0,2) - i2_u = UBOUND(SrcParamData%WaveDynP0,2) - i3_l = LBOUND(SrcParamData%WaveDynP0,3) - i3_u = UBOUND(SrcParamData%WaveDynP0,3) - IF (.NOT. ALLOCATED(DstParamData%WaveDynP0)) THEN - ALLOCATE(DstParamData%WaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveDynP0 = SrcParamData%WaveDynP0 -ENDIF - DstParamData%WaveTime => SrcParamData%WaveTime - DstParamData%PWaveVel0 => SrcParamData%PWaveVel0 - DstParamData%PWaveAcc0 => SrcParamData%PWaveAcc0 - DstParamData%PWaveAccMCF0 => SrcParamData%PWaveAccMCF0 - DstParamData%PWaveDynP0 => SrcParamData%PWaveDynP0 DstParamData%NStepWave = SrcParamData%NStepWave DstParamData%NMOutputs = SrcParamData%NMOutputs IF (ALLOCATED(SrcParamData%MOutLst)) THEN @@ -10861,13 +10528,8 @@ SUBROUTINE Morison_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Err ENDDO ENDIF DstParamData%NumOuts = SrcParamData%NumOuts - CALL SeaSt_Interp_CopyParam( SrcParamData%SeaSt_Interp_p, DstParamData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN DstParamData%WaveStMod = SrcParamData%WaveStMod - CALL SeaSt_WaveField_Copyseast_wavefieldtype( SrcParamData%WaveField, DstParamData%WaveField, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN + DstParamData%WaveField => SrcParamData%WaveField END SUBROUTINE Morison_CopyParam SUBROUTINE Morison_DestroyParam( ParamData, ErrStat, ErrMsg ) @@ -10920,29 +10582,6 @@ SUBROUTINE Morison_DestroyParam( ParamData, ErrStat, ErrMsg ) IF (ALLOCATED(ParamData%AM_End)) THEN DEALLOCATE(ParamData%AM_End) ENDIF -NULLIFY(ParamData%WaveElev1) -NULLIFY(ParamData%WaveElev2) -NULLIFY(ParamData%WaveVel) -NULLIFY(ParamData%WaveAcc) -NULLIFY(ParamData%WaveAccMCF) -NULLIFY(ParamData%WaveDynP) -IF (ALLOCATED(ParamData%WaveVel0)) THEN - DEALLOCATE(ParamData%WaveVel0) -ENDIF -IF (ALLOCATED(ParamData%WaveAcc0)) THEN - DEALLOCATE(ParamData%WaveAcc0) -ENDIF -IF (ALLOCATED(ParamData%WaveAccMCF0)) THEN - DEALLOCATE(ParamData%WaveAccMCF0) -ENDIF -IF (ALLOCATED(ParamData%WaveDynP0)) THEN - DEALLOCATE(ParamData%WaveDynP0) -ENDIF -NULLIFY(ParamData%WaveTime) -NULLIFY(ParamData%PWaveVel0) -NULLIFY(ParamData%PWaveAcc0) -NULLIFY(ParamData%PWaveAccMCF0) -NULLIFY(ParamData%PWaveDynP0) IF (ALLOCATED(ParamData%MOutLst)) THEN DO i1 = LBOUND(ParamData%MOutLst,1), UBOUND(ParamData%MOutLst,1) CALL Morison_DestroyMOutput( ParamData%MOutLst(i1), ErrStat2, ErrMsg2 ) @@ -10964,10 +10603,7 @@ SUBROUTINE Morison_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDDO DEALLOCATE(ParamData%OutParam) ENDIF - CALL SeaSt_Interp_DestroyParam( ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_WaveField_DestroySeaSt_WaveFieldType( ParamData%WaveField, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +NULLIFY(ParamData%WaveField) END SUBROUTINE Morison_DestroyParam SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -11088,26 +10724,6 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IF ( ALLOCATED(InData%AM_End) ) THEN Int_BufSz = Int_BufSz + 2*3 ! AM_End upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%AM_End) ! AM_End - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel0 allocated yes/no - IF ( ALLOCATED(InData%WaveVel0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! WaveVel0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel0) ! WaveVel0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc0 allocated yes/no - IF ( ALLOCATED(InData%WaveAcc0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! WaveAcc0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc0) ! WaveAcc0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAccMCF0 allocated yes/no - IF ( ALLOCATED(InData%WaveAccMCF0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! WaveAccMCF0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAccMCF0) ! WaveAccMCF0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP0 allocated yes/no - IF ( ALLOCATED(InData%WaveDynP0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveDynP0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP0) ! WaveDynP0 END IF Int_BufSz = Int_BufSz + 1 ! NStepWave Int_BufSz = Int_BufSz + 1 ! NMOutputs @@ -11182,41 +10798,7 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END DO END IF Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_p: size of buffers for each call to pack subtype - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SeaSt_Interp_p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SeaSt_Interp_p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SeaSt_Interp_p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF Int_BufSz = Int_BufSz + 1 ! WaveStMod - Int_BufSz = Int_BufSz + 3 ! WaveField: size of buffers for each call to pack subtype - CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WaveField - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WaveField - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WaveField - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -11489,121 +11071,6 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END DO END DO END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%WaveVel0,4), UBOUND(InData%WaveVel0,4) - DO i3 = LBOUND(InData%WaveVel0,3), UBOUND(InData%WaveVel0,3) - DO i2 = LBOUND(InData%WaveVel0,2), UBOUND(InData%WaveVel0,2) - DO i1 = LBOUND(InData%WaveVel0,1), UBOUND(InData%WaveVel0,1) - ReKiBuf(Re_Xferred) = InData%WaveVel0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAcc0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%WaveAcc0,4), UBOUND(InData%WaveAcc0,4) - DO i3 = LBOUND(InData%WaveAcc0,3), UBOUND(InData%WaveAcc0,3) - DO i2 = LBOUND(InData%WaveAcc0,2), UBOUND(InData%WaveAcc0,2) - DO i1 = LBOUND(InData%WaveAcc0,1), UBOUND(InData%WaveAcc0,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAccMCF0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%WaveAccMCF0,4), UBOUND(InData%WaveAccMCF0,4) - DO i3 = LBOUND(InData%WaveAccMCF0,3), UBOUND(InData%WaveAccMCF0,3) - DO i2 = LBOUND(InData%WaveAccMCF0,2), UBOUND(InData%WaveAccMCF0,2) - DO i1 = LBOUND(InData%WaveAccMCF0,1), UBOUND(InData%WaveAccMCF0,1) - ReKiBuf(Re_Xferred) = InData%WaveAccMCF0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDynP0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveDynP0,3), UBOUND(InData%WaveDynP0,3) - DO i2 = LBOUND(InData%WaveDynP0,2), UBOUND(InData%WaveDynP0,2) - DO i1 = LBOUND(InData%WaveDynP0,1), UBOUND(InData%WaveDynP0,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF IntKiBuf(Int_Xferred) = InData%NStepWave Int_Xferred = Int_Xferred + 1 @@ -11736,64 +11203,8 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END IF IntKiBuf(Int_Xferred) = InData%NumOuts Int_Xferred = Int_Xferred + 1 - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF IntKiBuf(Int_Xferred) = InData%WaveStMod Int_Xferred = Int_Xferred + 1 - CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF END SUBROUTINE Morison_PackParam SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -11812,8 +11223,6 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackParam' @@ -12118,144 +11527,6 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er END DO END DO END IF - NULLIFY(OutData%WaveElev1) - NULLIFY(OutData%WaveElev2) - NULLIFY(OutData%WaveVel) - NULLIFY(OutData%WaveAcc) - NULLIFY(OutData%WaveAccMCF) - NULLIFY(OutData%WaveDynP) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveVel0)) DEALLOCATE(OutData%WaveVel0) - ALLOCATE(OutData%WaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%WaveVel0,4), UBOUND(OutData%WaveVel0,4) - DO i3 = LBOUND(OutData%WaveVel0,3), UBOUND(OutData%WaveVel0,3) - DO i2 = LBOUND(OutData%WaveVel0,2), UBOUND(OutData%WaveVel0,2) - DO i1 = LBOUND(OutData%WaveVel0,1), UBOUND(OutData%WaveVel0,1) - OutData%WaveVel0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveAcc0)) DEALLOCATE(OutData%WaveAcc0) - ALLOCATE(OutData%WaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%WaveAcc0,4), UBOUND(OutData%WaveAcc0,4) - DO i3 = LBOUND(OutData%WaveAcc0,3), UBOUND(OutData%WaveAcc0,3) - DO i2 = LBOUND(OutData%WaveAcc0,2), UBOUND(OutData%WaveAcc0,2) - DO i1 = LBOUND(OutData%WaveAcc0,1), UBOUND(OutData%WaveAcc0,1) - OutData%WaveAcc0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAccMCF0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveAccMCF0)) DEALLOCATE(OutData%WaveAccMCF0) - ALLOCATE(OutData%WaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%WaveAccMCF0,4), UBOUND(OutData%WaveAccMCF0,4) - DO i3 = LBOUND(OutData%WaveAccMCF0,3), UBOUND(OutData%WaveAccMCF0,3) - DO i2 = LBOUND(OutData%WaveAccMCF0,2), UBOUND(OutData%WaveAccMCF0,2) - DO i1 = LBOUND(OutData%WaveAccMCF0,1), UBOUND(OutData%WaveAccMCF0,1) - OutData%WaveAccMCF0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveDynP0)) DEALLOCATE(OutData%WaveDynP0) - ALLOCATE(OutData%WaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveDynP0,3), UBOUND(OutData%WaveDynP0,3) - DO i2 = LBOUND(OutData%WaveDynP0,2), UBOUND(OutData%WaveDynP0,2) - DO i1 = LBOUND(OutData%WaveDynP0,1), UBOUND(OutData%WaveDynP0,1) - OutData%WaveDynP0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - NULLIFY(OutData%WaveTime) - NULLIFY(OutData%PWaveVel0) - NULLIFY(OutData%PWaveAcc0) - NULLIFY(OutData%PWaveAccMCF0) - NULLIFY(OutData%PWaveDynP0) OutData%NStepWave = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%NMOutputs = IntKiBuf(Int_Xferred) @@ -12432,88 +11703,9 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er END IF OutData%NumOuts = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_Interp_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) OutData%WaveStMod = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_WaveField_UnpackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + NULLIFY(OutData%WaveField) END SUBROUTINE Morison_UnPackParam SUBROUTINE Morison_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 739b2b5012..ce451d072b 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -825,31 +825,28 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_HD%WaveDOmega = Init%OutData_SeaSt%WaveDOmega Init%InData_HD%MCFD = Init%OutData_SeaSt%MCFD - CALL MOVE_ALLOC( Init%OutData_SeaSt%WaveElev0, Init%InData_HD%WaveElev0 ) + CALL MOVE_ALLOC( Init%OutData_SeaSt%WaveElev0, Init%InData_HD%WaveElev0 ) + CALL MOVE_ALLOC( Init%OutData_SeaSt%WaveElevC, Init%InData_HD%WaveElevC ) Init%InData_HD%WaveTime => Init%OutData_SeaSt%WaveTime - Init%InData_HD%WaveDynP => Init%OutData_SeaSt%WaveDynP - Init%InData_HD%WaveAcc => Init%OutData_SeaSt%WaveAcc - Init%InData_HD%WaveVel => Init%OutData_SeaSt%WaveVel - Init%InData_HD%PWaveDynP0 => Init%OutData_SeaSt%PWaveDynP0 - Init%InData_HD%PWaveAcc0 => Init%OutData_SeaSt%PWaveAcc0 - Init%InData_HD%PWaveVel0 => Init%OutData_SeaSt%PWaveVel0 Init%InData_HD%WaveElevC0 => Init%OutData_SeaSt%WaveElevC0 - CALL MOVE_ALLOC( Init%OutData_SeaSt%WaveElevC, Init%InData_HD%WaveElevC ) Init%InData_HD%WaveDirArr => Init%OutData_SeaSt%WaveDirArr Init%InData_HD%WaveElev1 => Init%OutData_SeaSt%WaveElev1 Init%InData_HD%WaveElev2 => Init%OutData_SeaSt%WaveElev2 - - Init%InData_HD%WaveAccMCF => Init%OutData_SeaSt%WaveAccMCF - Init%InData_HD%PWaveAccMCF0 => Init%OutData_SeaSt%PWaveAccMCF0 + + ! Init%InData_HD%WaveDynP => Init%OutData_SeaSt%WaveDynP + ! Init%InData_HD%WaveAcc => Init%OutData_SeaSt%WaveAcc + ! Init%InData_HD%WaveVel => Init%OutData_SeaSt%WaveVel + ! Init%InData_HD%PWaveDynP0 => Init%OutData_SeaSt%PWaveDynP0 + ! Init%InData_HD%PWaveAcc0 => Init%OutData_SeaSt%PWaveAcc0 + ! Init%InData_HD%PWaveVel0 => Init%OutData_SeaSt%PWaveVel0 + ! Init%InData_HD%WaveAccMCF => Init%OutData_SeaSt%WaveAccMCF + ! Init%InData_HD%PWaveAccMCF0 => Init%OutData_SeaSt%PWaveAccMCF0 call SeaSt_Interp_CopyParam(Init%OutData_SeaSt%SeaSt_Interp_p, Init%InData_HD%SeaSt_Interp_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! call SeaSt_WaveField_CopySeaSt_WaveFieldType( Init%OutData_SeaSt%WaveField, Init%InData_HD%WaveField, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - ! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) Init%InData_HD%WaveField => Init%OutData_SeaSt%WaveField - - + end if end if diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index 4aea57f6bc..4d6efea5ca 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -13,7 +13,7 @@ MODULE SeaSt_WaveField PUBLIC WaveField_GetTotalWaveElev PUBLIC WaveField_GetWaveNormal PUBLIC WaveField_GetWaveKin -PUBLIC WaveField_End +PUBLIC WaveField_GetWaveVel CONTAINS @@ -28,7 +28,7 @@ FUNCTION WaveField_GetWaveElev1( WaveField, Time, pos, ErrStat, ErrMsg ) REAL(SiKi) :: WaveField_GetWaveElev1 REAL(SiKi) :: Zeta LOGICAL :: FirstWarn_Clamp - CHARACTER(*), PARAMETER :: RoutineName = 'GetWaveElev1' + CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetWaveElev1' INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 @@ -56,7 +56,7 @@ FUNCTION WaveField_GetWaveElev2( WaveField, Time, pos, ErrStat, ErrMsg ) REAL(SiKi) :: WaveField_GetWaveElev2 REAL(SiKi) :: Zeta LOGICAL :: FirstWarn_Clamp - CHARACTER(*), PARAMETER :: RoutineName = 'GetWaveElev2' + CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetWaveElev2' INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 @@ -84,7 +84,7 @@ FUNCTION WaveField_GetTotalWaveElev( WaveField, Time, pos, ErrStat, ErrMsg ) REAL(SiKi) :: WaveField_GetTotalWaveElev REAL(SiKi) :: Zeta1, Zeta2 LOGICAL :: FirstWarn_Clamp - CHARACTER(*), PARAMETER :: RoutineName = 'GetTotalWaveElev' + CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetTotalWaveElev' INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 @@ -108,8 +108,9 @@ SUBROUTINE WaveField_GetWaveNormal( WaveField, Time, pos, r, n, ErrStat, ErrMsg 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(ReKi) :: r1,ZetaP,ZetaM,dZetadx,dZetady - CHARACTER(*), PARAMETER :: RoutineName = 'GetFreeSurfaceNormal' + REAL(SiKi) :: ZetaP,ZetaM + REAL(ReKi) :: r1,dZetadx,dZetady + CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetFreeSurfaceNormal' INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 ErrStat = ErrID_None @@ -121,13 +122,13 @@ SUBROUTINE WaveField_GetWaveNormal( WaveField, Time, pos, r, n, ErrStat, ErrMsg CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ZetaM = WaveField_GetTotalWaveElev( WaveField, Time, (/pos(1)-r1,pos(2)/), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - dZetadx = (ZetaP-ZetaM)/(2.0_ReKi*r1) + dZetadx = REAL(ZetaP-ZetaM,ReKi)/(2.0_ReKi*r1) ZetaP = WaveField_GetTotalWaveElev( WaveField, Time, (/pos(1),pos(2)+r1/), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ZetaM = WaveField_GetTotalWaveElev( WaveField, Time, (/pos(1),pos(2)-r1/), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - dZetady = (ZetaP-ZetaM)/(2.0_ReKi*r1) + dZetady = REAL(ZetaP-ZetaM,ReKi)/(2.0_ReKi*r1) n = (/-dZetadx,-dZetady,1.0_ReKi/) n = n / SQRT(Dot_Product(n,n)) @@ -135,10 +136,10 @@ SUBROUTINE WaveField_GetWaveNormal( WaveField, Time, pos, r, n, ErrStat, ErrMsg END SUBROUTINE WaveField_GetWaveNormal !-------------------- Subroutine for full wave field kinematics --------------------! -SUBROUTINE WaveField_GetWaveKin( WaveField, Time, posIn, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) +SUBROUTINE WaveField_GetWaveKin( WaveField, Time, pos, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField REAL(DbKi), INTENT( IN ) :: Time - REAL(ReKi), INTENT( IN ) :: posIn(3) + REAL(ReKi), INTENT( IN ) :: pos(3) REAL(SiKi), INTENT( OUT ) :: WaveElev1 REAL(SiKi), INTENT( OUT ) :: WaveElev2 REAL(SiKi), INTENT( OUT ) :: WaveElev @@ -151,19 +152,18 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, Time, posIn, nodeInWater, WaveElev1, INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None - REAL(ReKi) :: pos(3), posXY(2), posPrime(3), posXY0(3) + REAL(ReKi) :: posXY(2), posPrime(3), posXY0(3) TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m LOGICAL :: FirstWarn_Clamp - CHARACTER(*), PARAMETER :: RoutineName = 'GetWaveKin' + CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetWaveKin' INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 ErrStat = ErrID_None ErrMsg = "" - pos = (/posIn(1),posIn(2),posIn(3)-WaveField%MSL2SWL/) ! Vertical position measured from the SWL - posXY = posIn(1:2) - posXY0 = (/posIn(1),posIn(2),0.0_ReKi/) + posXY = pos(1:2) + posXY0 = (/pos(1),pos(2),0.0_ReKi/) FAMCF(:) = 0.0 ! Wave elevation @@ -178,17 +178,17 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, Time, posIn, nodeInWater, WaveElev1, 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 ) + 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 ) + 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 ) + 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 SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ELSE ! Node is above the SWL nodeInWater = 0_IntKi @@ -209,46 +209,46 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, Time, posIn, nodeInWater, WaveElev1, 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 ) + 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 ) + 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 ) + 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 SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) 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 ) + 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 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 ) + 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 SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN FAMCF(:) = SeaSt_Interp_4D_vec( WaveField%WaveAccMCF, seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ! Extrapoled wave stretching IF (WaveField%WaveStMod == 2) THEN FV(:) = FV(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FA(:) = FA(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveAcc0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FDynP = FDynP + SeaSt_Interp_3D ( Time, posXY, WaveField%PWaveDynP0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN FAMCF(:) = FAMCF(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveAccMCF0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF END IF @@ -256,24 +256,24 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, Time, posIn, nodeInWater, WaveElev1, 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] - posPrime = pos - posPrime(3) = WaveField%EffWtrDpth*(WaveField%EffWtrDpth+pos(3))/(WaveField%EffWtrDpth+WaveElev)-WaveField%EffWtrDpth + ! 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 - ! 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 ) - IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, seast_interp_m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - END IF + ! 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 ) + IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN + FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, seast_interp_m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + END IF ELSE ! Node is out of water - zero-out all wave dynamics @@ -289,24 +289,103 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, Time, posIn, nodeInWater, WaveElev1, END SUBROUTINE WaveField_GetWaveKin -SUBROUTINE WaveField_End( WaveField ) +!-------------------- Subroutine for wave field velocity only --------------------! +SUBROUTINE WaveField_GetWaveVel( WaveField, Time, pos, nodeInWater, FV, ErrStat, ErrMsg ) + TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + REAL(DbKi), INTENT( IN ) :: Time + REAL(ReKi), INTENT( IN ) :: pos(3) + 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) + TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m + LOGICAL :: FirstWarn_Clamp + CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetWaveVel' + INTEGER(IntKi) :: errStat2 + CHARACTER(ErrMsgLen) :: errMsg2 - TYPE(SeaSt_WaveFieldType), INTENT( INOUT ) :: WaveField + ErrStat = ErrID_None + ErrMsg = "" - ! Dissociate all pointers within WaveField and let SeaState deallocate the data - ! Temporary solution before the code is modified to exclusively use WaveField - ! NULLIFY( WaveField%WaveTime ) - ! NULLIFY( WaveField%WaveDynP ) - ! NULLIFY( WaveField%WaveAcc ) - ! NULLIFY( WaveField%WaveAccMCF ) - ! NULLIFY( WaveField%WaveVel ) - ! NULLIFY( WaveField%PWaveDynP0 ) - ! NULLIFY( WaveField%PWaveAcc0 ) - ! NULLIFY( WaveField%PWaveAccMCF0 ) - ! NULLIFY( WaveField%PWaveVel0 ) - ! NULLIFY( WaveField%WaveElev1 ) - ! NULLIFY( WaveField%WaveElev2 ) + posXY = pos(1:2) + posXY0 = (/pos(1),pos(2),0.0_ReKi/) -END SUBROUTINE WaveField_End + ! Wave elevation + WaveElev = WaveField_GetTotalWaveElev( WaveField, Time, pos, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + 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 ) + ELSE ! Node is above the SWL + nodeInWater = 0_IntKi + FV(:) = 0.0 + END IF + + ELSE ! Wave stretching enabled + + IF ( pos(3) <= WaveElev ) 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 ) + + 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 ) + + ! Extrapoled wave stretching + IF (WaveField%WaveStMod == 2) THEN + FV(:) = FV(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + 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] + posPrime = pos + posPrime(3) = WaveField%EffWtrDpth*(WaveField%EffWtrDpth+pos(3))/(WaveField%EffWtrDpth+WaveElev)-WaveField%EffWtrDpth + + ! 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 ) + + END IF + + ELSE ! Node is out of water - zero-out all wave dynamics + + 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 + +END SUBROUTINE WaveField_GetWaveVel END MODULE SeaSt_WaveField From 567bb8aecad33e1b14ebb4290b7b312b6c1c43b2 Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Tue, 30 May 2023 17:02:40 -0600 Subject: [PATCH 06/12] Removed the remaining direct passing of arrays from SeaState to HydroDyn. All arrays associated with the wave field are made components of the WaveField type, which HydroDyn can reference using a pointer. --- modules/hydrodyn/src/HydroDyn.f90 | 31 ++-- modules/hydrodyn/src/HydroDyn.txt | 12 +- modules/hydrodyn/src/HydroDyn_C_Binding.f90 | 21 +-- modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 18 +-- modules/hydrodyn/src/HydroDyn_Input.f90 | 2 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 111 -------------- modules/hydrodyn/src/SS_Excitation.f90 | 3 +- modules/hydrodyn/src/SS_Excitation.txt | 4 +- modules/hydrodyn/src/SS_Excitation_Types.f90 | 116 +-------------- modules/hydrodyn/src/WAMIT.f90 | 11 +- modules/hydrodyn/src/WAMIT.txt | 4 +- modules/hydrodyn/src/WAMIT_Types.f90 | 140 +----------------- modules/openfast-library/src/FAST_Subs.f90 | 20 +-- modules/seastate/src/SeaSt_WaveField.txt | 2 + .../seastate/src/SeaSt_WaveField_Types.f90 | 132 +++++++++++++++++ modules/seastate/src/SeaState.f90 | 7 +- modules/seastate/src/SeaState.txt | 6 +- modules/seastate/src/SeaState_Types.f90 | 140 +----------------- modules/seastate/src/UserWaves.f90 | 9 +- modules/seastate/src/Waves.f90 | 18 +-- 20 files changed, 243 insertions(+), 564 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index c02a5b99dc..1fe48f7e65 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -271,7 +271,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I !p%NWaveElev = InputFileData%Waves%NWaveElev p%NStepWave = InitInp%NStepWave - p%WaveTime => InitInp%WaveTime + p%WaveTime => InitInp%WaveField%WaveTime m%LastIndWave = 1 @@ -286,7 +286,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I InputFileData%WAMIT%WtrDpth = InputFileData%Morison%WtrDpth ! The data in InputFileData%Morison%WtrDpth was directly placed there when we parsed the HydroDyn input file p%NBody = InputFileData%NBody p%NBodyMod = InputFileData%NBodyMod - InputFileData%WAMIT%WaveElev1 => InitInp%WaveElev1 + InputFileData%WAMIT%WaveElev1 => InitInp%WaveField%WaveElev1 call AllocAry( m%F_PtfmAdd, 6*InputFileData%NBody, "m%F_PtfmAdd", ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) call AllocAry( m%F_Waves , 6*InputFileData%NBody, "m%F_Waves" , ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -363,14 +363,19 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Init inputs for the SS_Excitation model (set this just in case it will be used) InputFileData%WAMIT%WaveDir = InitInp%WaveDir - CALL MOVE_ALLOC( InitInp%WaveElev0, InputFileData%WAMIT%WaveElev0 ) + ! CALL MOVE_ALLOC( InitInp%WaveElev0, InputFileData%WAMIT%WaveElev0 ) + ! CALL MOVE_ALLOC( InitInp%WaveElevC, InputFileData%WAMIT%WaveElevC ) ! Temporarily move arrays to init input for WAMIT (save some space) - InputFileData%WAMIT%WaveTime => InitInp%WaveTime - InputFileData%WAMIT%WaveElevC0 => InitInp%WaveElevC0 - CALL MOVE_ALLOC( InitInp%WaveElevC, InputFileData%WAMIT%WaveElevC ) - InputFileData%WAMIT%seast_interp_p = InitInp%seast_interp_p - InputFileData%WAMIT%WaveDirArr => InitInp%WaveDirArr + InputFileData%WAMIT%WaveTime => InitInp%WaveField%WaveTime + InputFileData%WAMIT%WaveElev0 => InitInp%WaveField%WaveElev0 + InputFileData%WAMIT%WaveElevC => InitInp%WaveField%WaveElevC + InputFileData%WAMIT%WaveElevC0 => InitInp%WaveField%WaveElevC0 + InputFileData%WAMIT%WaveDirArr => InitInp%WaveField%WaveDirArr + + ! InputFileData%WAMIT%seast_interp_p = InitInp%WaveField%seast_interp_p + CALL SeaSt_Interp_CopyParam(InitInp%WaveField%seast_interp_p, InputFileData%WAMIT%seast_interp_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) CALL WAMIT_Init(InputFileData%WAMIT, m%u_WAMIT(1), p%WAMIT(1), x%WAMIT(1), xd%WAMIT(1), z%WAMIT, OtherState%WAMIT(1), & y%WAMIT(1), m%WAMIT(1), Interval, ErrStat2, ErrMsg2 ) @@ -435,8 +440,8 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! init input for WAMIT2 pointers to save space !InputFileData%WAMIT2%WaveTime => InitInp%WaveTime ! This isn't actually used within WAMIT2 GJH 9/30/2021 - InputFileData%WAMIT2%WaveElevC0 => InitInp%WaveElevC0 - InputFileData%WAMIT2%WaveDirArr => InitInp%WaveDirArr + InputFileData%WAMIT2%WaveElevC0 => InitInp%WaveField%WaveElevC0 + InputFileData%WAMIT2%WaveDirArr => InitInp%WaveField%WaveDirArr ! Copy Waves initialization output into the initialization input type for the WAMIT module InputFileData%WAMIT2%RhoXg = InitInp%RhoXg @@ -557,12 +562,12 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I RETURN END IF - ! Populate wave arrays + ! Populate wave arrays (Need to double chech this part. It doesn't look right!) Np = 2*(InitInp%WaveDOmega + 1) DO I = 1 , InitInp%NStepWave2 - dftreal = InitInp%WaveElevC0( 1,ABS(I ) ) - dftimag = InitInp%WaveElevC0( 2, ABS(I ) )*SIGN(1,I) + dftreal = InitInp%WaveField%WaveElevC0( 1, ABS(I ) ) + dftimag = InitInp%WaveField%WaveElevC0( 2, ABS(I ) )*SIGN(1,I) FITInitData%Wave_amp (I) = sqrt( dftreal**2 + dftimag**2 ) * 2.0 / Np FITInitData%Wave_omega (I) = I*InitInp%WaveDOmega FITInitData%Wave_number(I) = I*InitInp%WaveDOmega**2. / InputFileData%Gravity diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 32d4eab3ea..59c344d800 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -100,10 +100,10 @@ typedef ^ ^ SiKi WvHiCOffD typedef ^ ^ SiKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) -typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation (points to SeaState module data)" - -typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation (points to SeaState module data)" - +#typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation (points to SeaState module data)" - +#typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation (points to SeaState module data)" - typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) -typedef ^ ^ SiKi WaveTime {*} - - "Simulation times at which the instantaneous elevation of, velocity of, acceleration of, and loads associated with the incident waves are determined (points to SeaState module data)" (sec) +#typedef ^ ^ SiKi WaveTime {*} - - "Simulation times at which the instantaneous elevation of, velocity of, acceleration of, and loads associated with the incident waves are determined (points to SeaState module data)" (sec) #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 (points to SeaState module data)" (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 (points to SeaState module data)" (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 (points to SeaState module data)" (m/s^2) @@ -112,15 +112,15 @@ typedef ^ ^ SiKi WaveTime #typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "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 (points to SeaState module data)" (m/s^2) #typedef ^ ^ SiKi PWaveAccMCF0 {*}{*}{*}{*} - - "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 (points to SeaState module data)" (m/s^2) #typedef ^ ^ SiKi PWaveVel0 {*}{*}{*}{*} - - "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.) (points to SeaState module data)" (m/s) -typedef ^ ^ SiKi WaveElevC0 {*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part (points to SeaState module data)" (meters) +#typedef ^ ^ SiKi WaveElevC0 {*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part (points to SeaState module data)" (meters) typedef ^ ^ SiKi WaveElevC {:}{:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) -typedef ^ ^ SiKi WaveDirArr {*} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1 (points to SeaState module data)" (degrees) +#typedef ^ ^ SiKi WaveDirArr {*} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1 (points to SeaState module data)" (degrees) typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) 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 ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - +#typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - typedef ^ ^ SiKi MCFD - - - "Diameter of MacCamy-Fuchs members" (meters) typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - # diff --git a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 index 703a388cf0..80adcd7b05 100644 --- a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 +++ b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 @@ -426,14 +426,13 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, HD%InitInp%WaveDOmega = SeaSt%InitOutData%WaveDOmega HD%InitInp%MCFD = SeaSt%InitOutData%MCFD - CALL MOVE_ALLOC( SeaSt%InitOutData%WaveElev0, HD%InitInp%WaveElev0 ) - CALL MOVE_ALLOC( SeaSt%InitOutData%WaveElevC, HD%InitInp%WaveElevC ) - if(associated(SeaSt%InitOutData%WaveTime )) HD%InitInp%WaveTime => SeaSt%InitOutData%WaveTime - if(associated(SeaSt%InitOutData%WaveElevC0)) HD%InitInp%WaveElevC0 => SeaSt%InitOutData%WaveElevC0 - if(associated(SeaSt%InitOutData%WaveDirArr)) HD%InitInp%WaveDirArr => SeaSt%InitOutData%WaveDirArr - if(associated(SeaSt%InitOutData%WaveElev1 )) HD%InitInp%WaveElev1 => SeaSt%InitOutData%WaveElev1 - if(associated(SeaSt%InitOutData%WaveElev2 )) HD%InitInp%WaveElev2 => SeaSt%InitOutData%WaveElev2 - if(associated(SeaSt%InitOutData%WaveField )) HD%InitInp%WaveField => SeaSt%InitOutData%WaveField + ! CALL MOVE_ALLOC( SeaSt%InitOutData%WaveElev0, HD%InitInp%WaveElev0 ) + ! CALL MOVE_ALLOC( SeaSt%InitOutData%WaveElevC, HD%InitInp%WaveElevC ) + ! if(associated(SeaSt%InitOutData%WaveTime )) HD%InitInp%WaveTime => SeaSt%InitOutData%WaveTime + ! if(associated(SeaSt%InitOutData%WaveElevC0)) HD%InitInp%WaveElevC0 => SeaSt%InitOutData%WaveElevC0 + ! if(associated(SeaSt%InitOutData%WaveDirArr)) HD%InitInp%WaveDirArr => SeaSt%InitOutData%WaveDirArr + ! if(associated(SeaSt%InitOutData%WaveElev1 )) HD%InitInp%WaveElev1 => SeaSt%InitOutData%WaveElev1 + ! if(associated(SeaSt%InitOutData%WaveElev2 )) HD%InitInp%WaveElev2 => SeaSt%InitOutData%WaveElev2 ! if(associated(SeaSt%InitOutData%WaveDynP )) HD%InitInp%WaveDynP => SeaSt%InitOutData%WaveDynP ! if(associated(SeaSt%InitOutData%WaveAcc )) HD%InitInp%WaveAcc => SeaSt%InitOutData%WaveAcc ! if(associated(SeaSt%InitOutData%WaveVel )) HD%InitInp%WaveVel => SeaSt%InitOutData%WaveVel @@ -443,9 +442,11 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, ! HD%InitInp%WaveAccMCF => SeaSt%InitOutData%WaveAccMCF ! HD%InitInp%PWaveAccMCF0 => SeaSt%InitOutData%PWaveAccMCF0 - call SeaSt_Interp_CopyParam(SeaSt%InitOutData%SeaSt_Interp_p, HD%InitInp%SeaSt_Interp_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! call SeaSt_Interp_CopyParam(SeaSt%InitOutData%SeaSt_Interp_p, HD%InitInp%SeaSt_Interp_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) + ! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if(associated(SeaSt%InitOutData%WaveField )) HD%InitInp%WaveField => SeaSt%InitOutData%WaveField + ! Platform reference position ! The HD model uses this for building the moddel. This is only specified as an (X,Y) ! position (no Z). diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index fb1bc0d7b5..129f4f95d7 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -346,14 +346,12 @@ subroutine SetHD_InitInputs() InitInData_HD%WaveMultiDir = InitOutData_SeaSt%WaveMultiDir InitInData_HD%WaveDOmega = InitOutData_SeaSt%WaveDOmega InitInData_HD%MCFD = InitOutData_SeaSt%MCFD - CALL MOVE_ALLOC( InitOutData_SeaSt%WaveElev0, InitInData_HD%WaveElev0 ) - CALL MOVE_ALLOC( InitOutData_SeaSt%WaveElevC, InitInData_HD%WaveElevC ) - InitInData_HD%WaveTime => InitOutData_SeaSt%WaveTime - InitInData_HD%WaveElevC0 => InitOutData_SeaSt%WaveElevC0 - InitInData_HD%WaveDirArr => InitOutData_SeaSt%WaveDirArr - InitInData_HD%WaveElev1 => InitOutData_SeaSt%WaveElev1 - InitInData_HD%WaveElev2 => InitOutData_SeaSt%WaveElev2 - + + ! InitInData_HD%WaveTime => InitOutData_SeaSt%WaveTime + ! InitInData_HD%WaveElevC0 => InitOutData_SeaSt%WaveElevC0 + ! InitInData_HD%WaveDirArr => InitOutData_SeaSt%WaveDirArr + ! InitInData_HD%WaveElev1 => InitOutData_SeaSt%WaveElev1 + ! InitInData_HD%WaveElev2 => InitOutData_SeaSt%WaveElev2 ! InitInData_HD%WaveElev0 => InitOutData_SeaSt%WaveElev0 ! InitInData_HD%WaveDynP => InitOutData_SeaSt%WaveDynP ! InitInData_HD%WaveAcc => InitOutData_SeaSt%WaveAcc @@ -363,8 +361,10 @@ subroutine SetHD_InitInputs() ! InitInData_HD%PWaveVel0 => InitOutData_SeaSt%PWaveVel0 ! InitInData_HD%WaveAccMCF => InitOutData_SeaSt%WaveAccMCF ! InitInData_HD%PWaveAccMCF0 => InitOutData_SeaSt%PWaveAccMCF0 + ! CALL MOVE_ALLOC( InitOutData_SeaSt%WaveElev0, InitInData_HD%WaveElev0 ) + ! CALL MOVE_ALLOC( InitOutData_SeaSt%WaveElevC, InitInData_HD%WaveElevC ) + ! CALL SeaSt_Interp_CopyParam(InitOutData_SeaSt%SeaSt_Interp_p, InitInData_HD%SeaSt_Interp_p, MESH_NEWCOPY, ErrStat, ErrMsg ); CALL CheckError() - CALL SeaSt_Interp_CopyParam(InitOutData_SeaSt%SeaSt_Interp_p, InitInData_HD%SeaSt_Interp_p, MESH_NEWCOPY, ErrStat, ErrMsg ); CALL CheckError() InitInData_HD%WaveField => InitOutData_SeaSt%WaveField end subroutine SetHD_InitInputs diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index 1f533ea4fe..b7b3117521 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -1163,7 +1163,7 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS ! WaveMod - Wave kinematics model switch. -- Check that actual data was passed in from SeaState. If none exists, then set WaveMod=0 and warn - if (.not. associated(InitInp%WaveTime) .or. InitInp%NStepWave == 0) then + if (.not. associated(InitInp%WaveField) .or. InitInp%NStepWave == 0) then call SetErrStat( ErrID_Fatal,' No SeaState wave information available. Setting WaveMod=0.',ErrStat,ErrMsg,RoutineName) return endif diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index d8b8add2ef..e195fcde9c 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -108,19 +108,13 @@ MODULE HydroDyn_Types REAL(SiKi) :: WvLowCOffS !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] REAL(SiKi) :: WvHiCOffS !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] LOGICAL :: InvalidWithSSExctn !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation (points to SeaState module data) [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Simulation times at which the instantaneous elevation of, velocity of, acceleration of, and loads associated with the incident waves are determined (points to SeaState module data) [(sec)] - REAL(SiKi) , DIMENSION(:,:), POINTER :: WaveElevC0 => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part (points to SeaState module data) [(meters)] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevC !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 (points to SeaState module data) [(degrees)] REAL(SiKi) :: WaveDirMin !< Minimum wave direction. [(degrees)] REAL(SiKi) :: WaveDirMax !< Maximum wave direction. [(degrees)] REAL(SiKi) :: WaveDir !< Incident wave propagation heading direction [(degrees)] LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] REAL(SiKi) :: WaveDOmega !< Frequency step for incident wave calculations [(rad/s)] - TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] REAL(SiKi) :: MCFD !< Diameter of MacCamy-Fuchs members [(meters)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE HydroDyn_InitInputType @@ -1769,8 +1763,6 @@ SUBROUTINE HydroDyn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS DstInitInputData%InvalidWithSSExctn = SrcInitInputData%InvalidWithSSExctn - DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 - DstInitInputData%WaveElev2 => SrcInitInputData%WaveElev2 IF (ALLOCATED(SrcInitInputData%WaveElev0)) THEN i1_l = LBOUND(SrcInitInputData%WaveElev0,1) i1_u = UBOUND(SrcInitInputData%WaveElev0,1) @@ -1783,8 +1775,6 @@ SUBROUTINE HydroDyn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, END IF DstInitInputData%WaveElev0 = SrcInitInputData%WaveElev0 ENDIF - DstInitInputData%WaveTime => SrcInitInputData%WaveTime - DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 IF (ALLOCATED(SrcInitInputData%WaveElevC)) THEN i1_l = LBOUND(SrcInitInputData%WaveElevC,1) i1_u = UBOUND(SrcInitInputData%WaveElevC,1) @@ -1801,15 +1791,11 @@ SUBROUTINE HydroDyn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, END IF DstInitInputData%WaveElevC = SrcInitInputData%WaveElevC ENDIF - DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax DstInitInputData%WaveDir = SrcInitInputData%WaveDir DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega - CALL SeaSt_Interp_CopyParam( SrcInitInputData%SeaSt_Interp_p, DstInitInputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN DstInitInputData%MCFD = SrcInitInputData%MCFD DstInitInputData%WaveField => SrcInitInputData%WaveField END SUBROUTINE HydroDyn_CopyInitInput @@ -1829,19 +1815,12 @@ SUBROUTINE HydroDyn_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedFileData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -NULLIFY(InitInputData%WaveElev1) -NULLIFY(InitInputData%WaveElev2) IF (ALLOCATED(InitInputData%WaveElev0)) THEN DEALLOCATE(InitInputData%WaveElev0) ENDIF -NULLIFY(InitInputData%WaveTime) -NULLIFY(InitInputData%WaveElevC0) IF (ALLOCATED(InitInputData%WaveElevC)) THEN DEALLOCATE(InitInputData%WaveElevC) ENDIF -NULLIFY(InitInputData%WaveDirArr) - CALL SeaSt_Interp_DestroyParam( InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) NULLIFY(InitInputData%WaveField) END SUBROUTINE HydroDyn_DestroyInitInput @@ -1937,23 +1916,6 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_BufSz = Re_BufSz + 1 ! WaveDir Int_BufSz = Int_BufSz + 1 ! WaveMultiDir Re_BufSz = Re_BufSz + 1 ! WaveDOmega - Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_p: size of buffers for each call to pack subtype - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SeaSt_Interp_p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SeaSt_Interp_p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SeaSt_Interp_p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF Re_BufSz = Re_BufSz + 1 ! MCFD IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -2112,34 +2074,6 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 1 ReKiBuf(Re_Xferred) = InData%WaveDOmega Re_Xferred = Re_Xferred + 1 - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF ReKiBuf(Re_Xferred) = InData%MCFD Re_Xferred = Re_Xferred + 1 END SUBROUTINE HydroDyn_PackInitInput @@ -2265,8 +2199,6 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = Re_Xferred + 1 OutData%InvalidWithSSExctn = TRANSFER(IntKiBuf(Int_Xferred), OutData%InvalidWithSSExctn) Int_Xferred = Int_Xferred + 1 - NULLIFY(OutData%WaveElev1) - NULLIFY(OutData%WaveElev2) IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2285,8 +2217,6 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = Re_Xferred + 1 END DO END IF - NULLIFY(OutData%WaveTime) - NULLIFY(OutData%WaveElevC0) IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2315,7 +2245,6 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta END DO END DO END IF - NULLIFY(OutData%WaveDirArr) OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) Re_Xferred = Re_Xferred + 1 OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) @@ -2326,46 +2255,6 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Xferred = Int_Xferred + 1 OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) Re_Xferred = Re_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_Interp_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) OutData%MCFD = REAL(ReKiBuf(Re_Xferred), SiKi) Re_Xferred = Re_Xferred + 1 NULLIFY(OutData%WaveField) diff --git a/modules/hydrodyn/src/SS_Excitation.f90 b/modules/hydrodyn/src/SS_Excitation.f90 index 6025527774..145cdb37e5 100644 --- a/modules/hydrodyn/src/SS_Excitation.f90 +++ b/modules/hydrodyn/src/SS_Excitation.f90 @@ -293,7 +293,8 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini p%WaveTime => InitInp%WaveTime p%ExctnDisp = InitInp%ExctnDisp if (p%ExctnDisp == 0) then - call MOVE_ALLOC(InitInp%WaveElev0, p%WaveElev0) + ! call MOVE_ALLOC(InitInp%WaveElev0, p%WaveElev0) + p%WaveElev0 => InitInp%WaveElev0 else p%WaveElev1 => InitInp%WaveElev1 end if diff --git a/modules/hydrodyn/src/SS_Excitation.txt b/modules/hydrodyn/src/SS_Excitation.txt index 2126e1bf45..59986becaf 100644 --- a/modules/hydrodyn/src/SS_Excitation.txt +++ b/modules/hydrodyn/src/SS_Excitation.txt @@ -22,7 +22,7 @@ typedef ^ ^ IntKi typedef ^ ^ ReKi WaveDir - - - "Wave direction" rad typedef ^ ^ INTEGER NStepWave - - - "Number of timesteps in the WaveTime array" - typedef ^ ^ R8Ki PtfmRefztRot {:} - - "The rotation about zt of the body reference frame(s) from xt/yt" radians -typedef ^ ^ SiKi WaveElev0 {:} - - "Wave elevation time history at origin" m +typedef ^ ^ SiKi WaveElev0 {*} - - "Wave elevation time history at origin" m typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation (points to SeaState module data)" - typedef ^ ^ SiKi WaveTime {*} - - "Times where wave elevation is known (points to SeaState module data)" s typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - @@ -63,7 +63,7 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi C {:}{:} - - "C matrix" - typedef ^ ^ INTEGER numStates - 0 - "Number of states" - typedef ^ ^ DbKi Tc - - - "Time shift" s -typedef ^ ^ SiKi WaveElev0 {:} - - "Wave elevation time history at origin" m +typedef ^ ^ SiKi WaveElev0 {*} - - "Wave elevation time history at origin" m typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation (points to SeaState module data)" - typedef ^ ^ SiKi WaveTime {*} - - "Times where wave elevation is known (points to SeaState module data)" s typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 7f835f96c8..9a98d197dc 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -42,7 +42,7 @@ MODULE SS_Excitation_Types REAL(ReKi) :: WaveDir !< Wave direction [rad] INTEGER(IntKi) :: NStepWave !< Number of timesteps in the WaveTime array [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: PtfmRefztRot !< The rotation about zt of the body reference frame(s) from xt/yt [radians] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Wave elevation time history at origin [m] + REAL(SiKi) , DIMENSION(:), POINTER :: WaveElev0 => NULL() !< Wave elevation time history at origin [m] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation (points to SeaState module data) [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Times where wave elevation is known (points to SeaState module data) [s] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] @@ -93,7 +93,7 @@ MODULE SS_Excitation_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C !< C matrix [-] INTEGER(IntKi) :: numStates = 0 !< Number of states [-] REAL(DbKi) :: Tc !< Time shift [s] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Wave elevation time history at origin [m] + REAL(SiKi) , DIMENSION(:), POINTER :: WaveElev0 => NULL() !< Wave elevation time history at origin [m] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation (points to SeaState module data) [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Times where wave elevation is known (points to SeaState module data) [s] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] @@ -145,18 +145,7 @@ SUBROUTINE SS_Exc_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, E END IF DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot ENDIF -IF (ALLOCATED(SrcInitInputData%WaveElev0)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElev0,1) - i1_u = UBOUND(SrcInitInputData%WaveElev0,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElev0)) THEN - ALLOCATE(DstInitInputData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElev0 = SrcInitInputData%WaveElev0 -ENDIF + DstInitInputData%WaveElev0 => SrcInitInputData%WaveElev0 DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 DstInitInputData%WaveTime => SrcInitInputData%WaveTime CALL SeaSt_Interp_CopyParam( SrcInitInputData%SeaSt_Interp_p, DstInitInputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) @@ -180,9 +169,7 @@ SUBROUTINE SS_Exc_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) IF (ALLOCATED(InitInputData%PtfmRefztRot)) THEN DEALLOCATE(InitInputData%PtfmRefztRot) ENDIF -IF (ALLOCATED(InitInputData%WaveElev0)) THEN - DEALLOCATE(InitInputData%WaveElev0) -ENDIF +NULLIFY(InitInputData%WaveElev0) NULLIFY(InitInputData%WaveElev1) NULLIFY(InitInputData%WaveTime) CALL SeaSt_Interp_DestroyParam( InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) @@ -233,11 +220,6 @@ SUBROUTINE SS_Exc_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IF ( ALLOCATED(InData%PtfmRefztRot) ) THEN Int_BufSz = Int_BufSz + 2*1 ! PtfmRefztRot upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%PtfmRefztRot) ! PtfmRefztRot - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no - IF ( ALLOCATED(InData%WaveElev0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_p: size of buffers for each call to pack subtype @@ -310,21 +292,6 @@ SUBROUTINE SS_Exc_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DbKiBuf(Db_Xferred) = InData%PtfmRefztRot(i1) Db_Xferred = Db_Xferred + 1 END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) - ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) - Re_Xferred = Re_Xferred + 1 - END DO END IF CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -415,24 +382,7 @@ SUBROUTINE SS_Exc_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev0)) DEALLOCATE(OutData%WaveElev0) - ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) - OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF + NULLIFY(OutData%WaveElev0) NULLIFY(OutData%WaveElev1) NULLIFY(OutData%WaveTime) Buf_size=IntKiBuf( Int_Xferred ) @@ -1681,18 +1631,7 @@ SUBROUTINE SS_Exc_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM ENDIF DstParamData%numStates = SrcParamData%numStates DstParamData%Tc = SrcParamData%Tc -IF (ALLOCATED(SrcParamData%WaveElev0)) THEN - i1_l = LBOUND(SrcParamData%WaveElev0,1) - i1_u = UBOUND(SrcParamData%WaveElev0,1) - IF (.NOT. ALLOCATED(DstParamData%WaveElev0)) THEN - ALLOCATE(DstParamData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveElev0 = SrcParamData%WaveElev0 -ENDIF + DstParamData%WaveElev0 => SrcParamData%WaveElev0 DstParamData%WaveElev1 => SrcParamData%WaveElev1 DstParamData%WaveTime => SrcParamData%WaveTime CALL SeaSt_Interp_CopyParam( SrcParamData%SeaSt_Interp_p, DstParamData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) @@ -1725,9 +1664,7 @@ SUBROUTINE SS_Exc_DestroyParam( ParamData, ErrStat, ErrMsg ) IF (ALLOCATED(ParamData%C)) THEN DEALLOCATE(ParamData%C) ENDIF -IF (ALLOCATED(ParamData%WaveElev0)) THEN - DEALLOCATE(ParamData%WaveElev0) -ENDIF +NULLIFY(ParamData%WaveElev0) NULLIFY(ParamData%WaveElev1) NULLIFY(ParamData%WaveTime) CALL SeaSt_Interp_DestroyParam( ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) @@ -1795,11 +1732,6 @@ SUBROUTINE SS_Exc_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg END IF Int_BufSz = Int_BufSz + 1 ! numStates Db_BufSz = Db_BufSz + 1 ! Tc - Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no - IF ( ALLOCATED(InData%WaveElev0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 - END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_p: size of buffers for each call to pack subtype CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt_Interp_p @@ -1927,21 +1859,6 @@ SUBROUTINE SS_Exc_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_Xferred = Int_Xferred + 1 DbKiBuf(Db_Xferred) = InData%Tc Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) - ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2095,24 +2012,7 @@ SUBROUTINE SS_Exc_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Xferred = Int_Xferred + 1 OutData%Tc = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev0)) DEALLOCATE(OutData%WaveElev0) - ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) - OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF + NULLIFY(OutData%WaveElev0) NULLIFY(OutData%WaveElev1) NULLIFY(OutData%WaveTime) Buf_size=IntKiBuf( Int_Xferred ) diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index 97a09cdeb8..5a636df0af 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -927,9 +927,8 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS SS_Exctn_InitInp%ExctnDisp = InitInp%ExctnDisp ! No other modules need this WaveElev0 array so we will simply move the allocation over to the SS_Exctn module - IF (ALLOCATED(InitInp%WaveElev0)) CALL MOVE_ALLOC(InitInp%WaveElev0, SS_Exctn_InitInp%WaveElev0) - !SS_Exctn_InitInp%WaveElev0 => InitInp%WaveElev0 - SS_Exctn_InitInp%WaveElev1 => InitInp%WaveElev1 + IF (ASSOCIATED(InitInp%WaveElev0)) SS_Exctn_InitInp%WaveElev0 => InitInp%WaveElev0 + IF (ASSOCIATED(InitInp%WaveElev1)) SS_Exctn_InitInp%WaveElev1 => InitInp%WaveElev1 !TODO: Verify what happens within SS_Exctn when we have no waves. ! We need the WaveTime array to stay intact for use in other modules, so we will make a copy instead of moving the allocation @@ -1235,11 +1234,11 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! however, if we are using the special case, then WaveElev0 will be modified. This is okay, because no one else ! is using WaveElev0 data if (p%ExctnDisp == 0 ) then - if (allocated(InitInp%WaveElev0)) then + if (associated(InitInp%WaveElev0)) then ! No other modules need this WaveElev0 array so we will simply move the allocation over to the SS_Exctn module - call MOVE_ALLOC(InitInp%WaveElev0, SS_Exctn_InitInp%WaveElev0) - ! SS_Exctn_InitInp%WaveElev0 => InitInp%WaveElev0 + ! call MOVE_ALLOC(InitInp%WaveElev0, SS_Exctn_InitInp%WaveElev0) + SS_Exctn_InitInp%WaveElev0 => InitInp%WaveElev0 ! Handle special case when NBodyMod=2 and (PtfmRefxt /= 0 or PtfmRefyt /= 0) : Need to phase shift the wave elevation data for the offset body if ( p%NBodyMod==2 .and. (InitInp%PtfmRefxt(1) /= 0 .or. InitInp%PtfmRefyt(1) /= 0) ) then diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index 4e9d618998..6024a4e662 100644 --- a/modules/hydrodyn/src/WAMIT.txt +++ b/modules/hydrodyn/src/WAMIT.txt @@ -46,10 +46,10 @@ typedef ^ ^ ReKi typedef ^ ^ INTEGER NStepWave - - - "" - typedef ^ ^ INTEGER NStepWave2 - - - "" - typedef ^ ^ ReKi WaveDOmega - - - "" - -typedef ^ ^ SiKi WaveElev0 {:} - - "Wave elevation time history at origin (needed for SS_Excitation module)" m +typedef ^ ^ SiKi WaveElev0 {*} - - "Wave elevation time history at origin (needed for SS_Excitation module)" m typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation (points to SeaState module data)" - typedef ^ ^ SiKi WaveElevC0 {*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part (points to SeaState module data)" (meters) -typedef ^ ^ SiKi WaveElevC {:}{:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) +typedef ^ ^ SiKi WaveElevC {*}{*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) typedef ^ ^ SiKi WaveTime {*} - - "(points to SeaState module data)" - typedef ^ ^ INTEGER WaveMod - - - "" - typedef ^ ^ ReKi WtrDens - - - "" - diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index bbc2522890..b89a163f66 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -63,10 +63,10 @@ MODULE WAMIT_Types INTEGER(IntKi) :: NStepWave !< [-] INTEGER(IntKi) :: NStepWave2 !< [-] REAL(ReKi) :: WaveDOmega !< [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Wave elevation time history at origin (needed for SS_Excitation module) [m] + REAL(SiKi) , DIMENSION(:), POINTER :: WaveElev0 => NULL() !< Wave elevation time history at origin (needed for SS_Excitation module) [m] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation (points to SeaState module data) [-] REAL(SiKi) , DIMENSION(:,:), POINTER :: WaveElevC0 => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part (points to SeaState module data) [(meters)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevC !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] + REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElevC => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< (points to SeaState module data) [-] INTEGER(IntKi) :: WaveMod !< [-] REAL(ReKi) :: WtrDens !< [-] @@ -278,36 +278,10 @@ SUBROUTINE WAMIT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega -IF (ALLOCATED(SrcInitInputData%WaveElev0)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElev0,1) - i1_u = UBOUND(SrcInitInputData%WaveElev0,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElev0)) THEN - ALLOCATE(DstInitInputData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElev0 = SrcInitInputData%WaveElev0 -ENDIF + DstInitInputData%WaveElev0 => SrcInitInputData%WaveElev0 DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 -IF (ALLOCATED(SrcInitInputData%WaveElevC)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevC,1) - i1_u = UBOUND(SrcInitInputData%WaveElevC,1) - i2_l = LBOUND(SrcInitInputData%WaveElevC,2) - i2_u = UBOUND(SrcInitInputData%WaveElevC,2) - i3_l = LBOUND(SrcInitInputData%WaveElevC,3) - i3_u = UBOUND(SrcInitInputData%WaveElevC,3) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevC)) THEN - ALLOCATE(DstInitInputData%WaveElevC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevC = SrcInitInputData%WaveElevC -ENDIF + DstInitInputData%WaveElevC => SrcInitInputData%WaveElevC DstInitInputData%WaveTime => SrcInitInputData%WaveTime DstInitInputData%WaveMod = SrcInitInputData%WaveMod DstInitInputData%WtrDens = SrcInitInputData%WtrDens @@ -355,14 +329,10 @@ SUBROUTINE WAMIT_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) ENDIF CALL Conv_Rdtn_DestroyInitInput( InitInputData%Conv_Rdtn, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitInputData%WaveElev0)) THEN - DEALLOCATE(InitInputData%WaveElev0) -ENDIF +NULLIFY(InitInputData%WaveElev0) NULLIFY(InitInputData%WaveElev1) NULLIFY(InitInputData%WaveElevC0) -IF (ALLOCATED(InitInputData%WaveElevC)) THEN - DEALLOCATE(InitInputData%WaveElevC) -ENDIF +NULLIFY(InitInputData%WaveElevC) NULLIFY(InitInputData%WaveTime) NULLIFY(InitInputData%WaveDirArr) CALL SeaSt_Interp_DestroyParam( InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) @@ -474,16 +444,6 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_BufSz = Int_BufSz + 1 ! NStepWave Int_BufSz = Int_BufSz + 1 ! NStepWave2 Re_BufSz = Re_BufSz + 1 ! WaveDOmega - Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no - IF ( ALLOCATED(InData%WaveElev0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevC allocated yes/no - IF ( ALLOCATED(InData%WaveElevC) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElevC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC) ! WaveElevC - END IF Int_BufSz = Int_BufSz + 1 ! WaveMod Re_BufSz = Re_BufSz + 1 ! WtrDens Re_BufSz = Re_BufSz + 1 ! WaveDirMin @@ -701,46 +661,6 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_Xferred = Int_Xferred + 1 ReKiBuf(Re_Xferred) = InData%WaveDOmega Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) - ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElevC,3), UBOUND(InData%WaveElevC,3) - DO i2 = LBOUND(InData%WaveElevC,2), UBOUND(InData%WaveElevC,2) - DO i1 = LBOUND(InData%WaveElevC,1), UBOUND(InData%WaveElevC,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF IntKiBuf(Int_Xferred) = InData%WaveMod Int_Xferred = Int_Xferred + 1 ReKiBuf(Re_Xferred) = InData%WtrDens @@ -1010,54 +930,10 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Xferred = Int_Xferred + 1 OutData%WaveDOmega = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev0)) DEALLOCATE(OutData%WaveElev0) - ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) - OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF + NULLIFY(OutData%WaveElev0) NULLIFY(OutData%WaveElev1) NULLIFY(OutData%WaveElevC0) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevC)) DEALLOCATE(OutData%WaveElevC) - ALLOCATE(OutData%WaveElevC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElevC,3), UBOUND(OutData%WaveElevC,3) - DO i2 = LBOUND(OutData%WaveElevC,2), UBOUND(OutData%WaveElevC,2) - DO i1 = LBOUND(OutData%WaveElevC,1), UBOUND(OutData%WaveElevC,1) - OutData%WaveElevC(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF + NULLIFY(OutData%WaveElevC) NULLIFY(OutData%WaveTime) OutData%WaveMod = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index ce451d072b..b1adf40a72 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -825,14 +825,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_HD%WaveDOmega = Init%OutData_SeaSt%WaveDOmega Init%InData_HD%MCFD = Init%OutData_SeaSt%MCFD - CALL MOVE_ALLOC( Init%OutData_SeaSt%WaveElev0, Init%InData_HD%WaveElev0 ) - CALL MOVE_ALLOC( Init%OutData_SeaSt%WaveElevC, Init%InData_HD%WaveElevC ) - Init%InData_HD%WaveTime => Init%OutData_SeaSt%WaveTime - Init%InData_HD%WaveElevC0 => Init%OutData_SeaSt%WaveElevC0 - Init%InData_HD%WaveDirArr => Init%OutData_SeaSt%WaveDirArr - Init%InData_HD%WaveElev1 => Init%OutData_SeaSt%WaveElev1 - Init%InData_HD%WaveElev2 => Init%OutData_SeaSt%WaveElev2 - + ! CALL MOVE_ALLOC( Init%OutData_SeaSt%WaveElev0, Init%InData_HD%WaveElev0 ) + ! CALL MOVE_ALLOC( Init%OutData_SeaSt%WaveElevC, Init%InData_HD%WaveElevC ) + + ! Init%InData_HD%WaveTime => Init%OutData_SeaSt%WaveTime + ! Init%InData_HD%WaveElevC0 => Init%OutData_SeaSt%WaveElevC0 + ! Init%InData_HD%WaveDirArr => Init%OutData_SeaSt%WaveDirArr + ! Init%InData_HD%WaveElev1 => Init%OutData_SeaSt%WaveElev1 + ! Init%InData_HD%WaveElev2 => Init%OutData_SeaSt%WaveElev2 ! Init%InData_HD%WaveDynP => Init%OutData_SeaSt%WaveDynP ! Init%InData_HD%WaveAcc => Init%OutData_SeaSt%WaveAcc ! Init%InData_HD%WaveVel => Init%OutData_SeaSt%WaveVel @@ -842,8 +842,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Init%InData_HD%WaveAccMCF => Init%OutData_SeaSt%WaveAccMCF ! Init%InData_HD%PWaveAccMCF0 => Init%OutData_SeaSt%PWaveAccMCF0 - call SeaSt_Interp_CopyParam(Init%OutData_SeaSt%SeaSt_Interp_p, Init%InData_HD%SeaSt_Interp_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! call SeaSt_Interp_CopyParam(Init%OutData_SeaSt%SeaSt_Interp_p, Init%InData_HD%SeaSt_Interp_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) + ! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) Init%InData_HD%WaveField => Init%OutData_SeaSt%WaveField diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index 32a0702405..d46f9fb211 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -14,12 +14,14 @@ typedef ^ ^ SiKi typedef ^ ^ SiKi PWaveAcc0 {:}{:}{:}{:} - - "Partial derivative of incident wave acceleration in the vertical direction at the still water level" (m/s^2/m) typedef ^ ^ SiKi PWaveAccMCF0 {:}{:}{:}{:} - - "Partial derivative of scaled wave acceleration in the vertical direction at the still water level for MacCamy-Fuchs members" (m/s^2/m) typedef ^ ^ SiKi PWaveVel0 {:}{:}{:}{:} - - "Partial derivative of incident wave velocity in the vertical direction at the still water level" (m/s/m) +typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (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 ^ ^ IntKi WaveStMod - - - "Wave stretching model" typedef ^ ^ ReKi EffWtrDpth - - - "Water depth" (-) typedef ^ ^ ReKi MSL2SWL - - - "Vertical distance from mean sea level to still water level" (m) +typedef ^ ^ SiKi WaveElevC {:}{:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (m) typedef ^ ^ SiKi WaveElevC0 {:}{:} - - "Fourier components of the incident wave elevation at the platform reference point. First column is the real part; second column is the imaginary part" (m) typedef ^ ^ SiKi WaveDirArr {:} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 79e57025c3..4b06eacd1d 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -45,12 +45,14 @@ MODULE SeaSt_WaveField_Types REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: PWaveAcc0 !< Partial derivative of incident wave acceleration in the vertical direction at the still water level [(m/s^2/m)] REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: PWaveAccMCF0 !< Partial derivative of scaled wave acceleration in the vertical direction at the still water level for MacCamy-Fuchs members [(m/s^2/m)] REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: PWaveVel0 !< Partial derivative of incident wave velocity in the vertical direction at the still water level [(m/s/m)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(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 [(-)] INTEGER(IntKi) :: WaveStMod !< Wave stretching model [-] REAL(ReKi) :: EffWtrDpth !< Water depth [(-)] REAL(ReKi) :: MSL2SWL !< Vertical distance from mean sea level to still water level [(m)] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevC !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(m)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevC0 !< Fourier components of the incident wave elevation at the platform reference point. First column is the real part; second column is the imaginary part [(m)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveDirArr !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] END TYPE SeaSt_WaveFieldType @@ -235,6 +237,18 @@ SUBROUTINE SeaSt_WaveField_CopySeaSt_WaveFieldType( SrcSeaSt_WaveFieldTypeData, END IF DstSeaSt_WaveFieldTypeData%PWaveVel0 = SrcSeaSt_WaveFieldTypeData%PWaveVel0 ENDIF +IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveElev0)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev0,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev0,1) + IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveElev0)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElev0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%WaveElev0 = SrcSeaSt_WaveFieldTypeData%WaveElev0 +ENDIF IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveElev1)) THEN i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,1) i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,1) @@ -273,6 +287,22 @@ SUBROUTINE SeaSt_WaveField_CopySeaSt_WaveFieldType( SrcSeaSt_WaveFieldTypeData, DstSeaSt_WaveFieldTypeData%WaveStMod = SrcSeaSt_WaveFieldTypeData%WaveStMod DstSeaSt_WaveFieldTypeData%EffWtrDpth = SrcSeaSt_WaveFieldTypeData%EffWtrDpth DstSeaSt_WaveFieldTypeData%MSL2SWL = SrcSeaSt_WaveFieldTypeData%MSL2SWL +IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveElevC)) THEN + i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC,1) + i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC,1) + i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC,2) + i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC,2) + i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC,3) + i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC,3) + IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveElevC)) THEN + ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveElevC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElevC.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaSt_WaveFieldTypeData%WaveElevC = SrcSeaSt_WaveFieldTypeData%WaveElevC +ENDIF IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveElevC0)) THEN i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC0,1) i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC0,1) @@ -341,6 +371,9 @@ SUBROUTINE SeaSt_WaveField_DestroySeaSt_WaveFieldType( SeaSt_WaveFieldTypeData, IF (ALLOCATED(SeaSt_WaveFieldTypeData%PWaveVel0)) THEN DEALLOCATE(SeaSt_WaveFieldTypeData%PWaveVel0) ENDIF +IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveElev0)) THEN + DEALLOCATE(SeaSt_WaveFieldTypeData%WaveElev0) +ENDIF IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveElev1)) THEN DEALLOCATE(SeaSt_WaveFieldTypeData%WaveElev1) ENDIF @@ -349,6 +382,9 @@ SUBROUTINE SeaSt_WaveField_DestroySeaSt_WaveFieldType( SeaSt_WaveFieldTypeData, ENDIF CALL SeaSt_Interp_DestroyParam( SeaSt_WaveFieldTypeData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveElevC)) THEN + DEALLOCATE(SeaSt_WaveFieldTypeData%WaveElevC) +ENDIF IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveElevC0)) THEN DEALLOCATE(SeaSt_WaveFieldTypeData%WaveElevC0) ENDIF @@ -437,6 +473,11 @@ SUBROUTINE SeaSt_WaveField_PackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Int_BufSz = Int_BufSz + 2*4 ! PWaveVel0 upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%PWaveVel0) ! PWaveVel0 END IF + Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no + IF ( ALLOCATED(InData%WaveElev0) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 + END IF Int_BufSz = Int_BufSz + 1 ! WaveElev1 allocated yes/no IF ( ALLOCATED(InData%WaveElev1) ) THEN Int_BufSz = Int_BufSz + 2*3 ! WaveElev1 upper/lower bounds for each dimension @@ -468,6 +509,11 @@ SUBROUTINE SeaSt_WaveField_PackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Int_BufSz = Int_BufSz + 1 ! WaveStMod Re_BufSz = Re_BufSz + 1 ! EffWtrDpth Re_BufSz = Re_BufSz + 1 ! MSL2SWL + Int_BufSz = Int_BufSz + 1 ! WaveElevC allocated yes/no + IF ( ALLOCATED(InData%WaveElevC) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! WaveElevC upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC) ! WaveElevC + END IF Int_BufSz = Int_BufSz + 1 ! WaveElevC0 allocated yes/no IF ( ALLOCATED(InData%WaveElevC0) ) THEN Int_BufSz = Int_BufSz + 2*2 ! WaveElevC0 upper/lower bounds for each dimension @@ -770,6 +816,21 @@ SUBROUTINE SeaSt_WaveField_PackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf, END DO END DO END IF + IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) + ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF IF ( .NOT. ALLOCATED(InData%WaveElev1) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -854,6 +915,31 @@ SUBROUTINE SeaSt_WaveField_PackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%MSL2SWL Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%WaveElevC) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%WaveElevC,3), UBOUND(InData%WaveElevC,3) + DO i2 = LBOUND(InData%WaveElevC,2), UBOUND(InData%WaveElevC,2) + DO i1 = LBOUND(InData%WaveElevC,1), UBOUND(InData%WaveElevC,1) + ReKiBuf(Re_Xferred) = InData%WaveElevC(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF IF ( .NOT. ALLOCATED(InData%WaveElevC0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1214,6 +1300,24 @@ SUBROUTINE SeaSt_WaveField_UnPackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf END DO END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElev0)) DEALLOCATE(OutData%WaveElev0) + ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) + OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev1 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1316,6 +1420,34 @@ SUBROUTINE SeaSt_WaveField_UnPackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf Re_Xferred = Re_Xferred + 1 OutData%MSL2SWL = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElevC)) DEALLOCATE(OutData%WaveElevC) + ALLOCATE(OutData%WaveElevC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%WaveElevC,3), UBOUND(OutData%WaveElevC,3) + DO i2 = LBOUND(OutData%WaveElevC,2), UBOUND(OutData%WaveElevC,2) + DO i1 = LBOUND(OutData%WaveElevC,1), UBOUND(OutData%WaveElevC,1) + OutData%WaveElevC(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated Int_Xferred = Int_Xferred + 1 ELSE diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 32629509c0..e575efbf1e 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -524,15 +524,14 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%WaveElevC0 => p%WaveField%WaveElevC0 ! For WAMIT and WAMIT2, FIT InitOut%WaveDirArr => p%WaveField%WaveDirArr ! For WAMIT and WAMIT2 InitOut%PWaveAccMCF0 => p%WaveField%PWaveAccMCF0 ! For Morison (MacCamy-Fuchs) - + InitOut%WaveElevC => p%WaveField%WaveElevC ! For WAMIT + InitOut%WaveElev0 => p%WaveField%WaveElev0 + ! non-pointer data: - CALL MOVE_ALLOC( Waves_InitOut%WaveElevC, InitOut%WaveElevC ) ! For WAMIT InitOut%WaveDirMin = Waves_InitOut%WaveDirMin ! For WAMIT and WAMIT2 InitOut%WaveDirMax = Waves_InitOut%WaveDirMax ! For WAMIT and WAMIT2 InitOut%WaveDOmega = Waves_InitOut%WaveDOmega ! For WAMIT and WAMIT2, FIT - - call MOVE_ALLOC(Waves_InitOut%WaveElev0, InitOut%WaveElev0 ) InitOut%RhoXg = Waves_InitOut%RhoXg ! For WAMIT and WAMIT2 InitOut%NStepWave = Waves_InitOut%NStepWave ! For WAMIT, WAMIT2, SS_Excitation, Morison InitOut%NStepWave2 = Waves_InitOut%NStepWave2 ! For WAMIT and WAMIT2, FIT diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index c56ca1ce82..3684f7fcd7 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -75,8 +75,8 @@ typedef ^ ^ ProgDesc Ver typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) typedef ^ ^ ReKi WtrDpth - - - "Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default)" (m) typedef ^ ^ ReKi MSL2SWL - - - "Offset between still-water level and mean sea level, this is necessary to inform glue-code what the module is using for MSL2SWL (may not be the glue-code's default)" (m) -typedef ^ ^ SiKi WaveElevC0 {*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part" (meters) -typedef ^ ^ SiKi WaveElevC {:}{:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) +typedef ^ ^ SiKi WaveElevC0 {*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part" (meters) +typedef ^ ^ SiKi WaveElevC {*}{*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) typedef ^ ^ SiKi WaveDirArr {*} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) @@ -93,7 +93,7 @@ typedef ^ ^ SiKi PWaveAccMCF0 typedef ^ ^ SiKi PWaveVel0 {*}{*}{*}{*} - - "Instantaneous velocity 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 (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) typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation" - typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation" - -typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) +typedef ^ ^ SiKi WaveElev0 {*} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) typedef ^ ^ SiKi WaveTime {*} - - "Simulation times at which the instantaneous elevation of, velocity of, acceleration of, and loads associated with the incident waves are determined" (sec) typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index ae08aecad4..68240b316b 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -97,7 +97,7 @@ MODULE SeaState_Types REAL(ReKi) :: WtrDpth !< Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default) [(m)] REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level, this is necessary to inform glue-code what the module is using for MSL2SWL (may not be the glue-code's default) [(m)] REAL(SiKi) , DIMENSION(:,:), POINTER :: WaveElevC0 => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part [(meters)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevC !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] + REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElevC => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] REAL(SiKi) :: WaveDirMin !< Minimum wave direction. [(degrees)] REAL(SiKi) :: WaveDirMax !< Maximum wave direction. [(degrees)] @@ -114,7 +114,7 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveVel0 => NULL() !< Instantaneous velocity 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 (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)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation [-] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] + REAL(SiKi) , DIMENSION(:), POINTER :: WaveElev0 => NULL() !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Simulation times at which the instantaneous elevation of, velocity of, acceleration of, and loads associated with the incident waves are determined [(sec)] REAL(SiKi) :: RhoXg !< = WtrDens*Gravity [-] INTEGER(IntKi) :: NStepWave !< Total number of frequency components = total number of time steps in the incident wave [-] @@ -1473,22 +1473,7 @@ SUBROUTINE SeaSt_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WtrDpth = SrcInitOutputData%WtrDpth DstInitOutputData%MSL2SWL = SrcInitOutputData%MSL2SWL DstInitOutputData%WaveElevC0 => SrcInitOutputData%WaveElevC0 -IF (ALLOCATED(SrcInitOutputData%WaveElevC)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElevC,1) - i1_u = UBOUND(SrcInitOutputData%WaveElevC,1) - i2_l = LBOUND(SrcInitOutputData%WaveElevC,2) - i2_u = UBOUND(SrcInitOutputData%WaveElevC,2) - i3_l = LBOUND(SrcInitOutputData%WaveElevC,3) - i3_u = UBOUND(SrcInitOutputData%WaveElevC,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveElevC)) THEN - ALLOCATE(DstInitOutputData%WaveElevC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElevC = SrcInitOutputData%WaveElevC -ENDIF + DstInitOutputData%WaveElevC => SrcInitOutputData%WaveElevC DstInitOutputData%WaveDirArr => SrcInitOutputData%WaveDirArr DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax @@ -1505,18 +1490,7 @@ SUBROUTINE SeaSt_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%PWaveVel0 => SrcInitOutputData%PWaveVel0 DstInitOutputData%WaveElev1 => SrcInitOutputData%WaveElev1 DstInitOutputData%WaveElev2 => SrcInitOutputData%WaveElev2 -IF (ALLOCATED(SrcInitOutputData%WaveElev0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElev0,1) - i1_u = UBOUND(SrcInitOutputData%WaveElev0,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveElev0)) THEN - ALLOCATE(DstInitOutputData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElev0 = SrcInitOutputData%WaveElev0 -ENDIF + DstInitOutputData%WaveElev0 => SrcInitOutputData%WaveElev0 DstInitOutputData%WaveTime => SrcInitOutputData%WaveTime DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave @@ -1574,9 +1548,7 @@ SUBROUTINE SeaSt_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) NULLIFY(InitOutputData%WaveElevC0) -IF (ALLOCATED(InitOutputData%WaveElevC)) THEN - DEALLOCATE(InitOutputData%WaveElevC) -ENDIF +NULLIFY(InitOutputData%WaveElevC) NULLIFY(InitOutputData%WaveDirArr) NULLIFY(InitOutputData%WaveDynP) NULLIFY(InitOutputData%WaveAcc) @@ -1588,9 +1560,7 @@ SUBROUTINE SeaSt_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) NULLIFY(InitOutputData%PWaveVel0) NULLIFY(InitOutputData%WaveElev1) NULLIFY(InitOutputData%WaveElev2) -IF (ALLOCATED(InitOutputData%WaveElev0)) THEN - DEALLOCATE(InitOutputData%WaveElev0) -ENDIF +NULLIFY(InitOutputData%WaveElev0) NULLIFY(InitOutputData%WaveTime) CALL SeaSt_Interp_DestroyParam( InitOutputData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1666,21 +1636,11 @@ SUBROUTINE SeaSt_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Re_BufSz = Re_BufSz + 1 ! WtrDens Re_BufSz = Re_BufSz + 1 ! WtrDpth Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1 ! WaveElevC allocated yes/no - IF ( ALLOCATED(InData%WaveElevC) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElevC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC) ! WaveElevC - END IF Re_BufSz = Re_BufSz + 1 ! WaveDirMin Re_BufSz = Re_BufSz + 1 ! WaveDirMax Re_BufSz = Re_BufSz + 1 ! WaveDir Int_BufSz = Int_BufSz + 1 ! WaveMultiDir Re_BufSz = Re_BufSz + 1 ! WaveDOmega - Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no - IF ( ALLOCATED(InData%WaveElev0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 - END IF Re_BufSz = Re_BufSz + 1 ! RhoXg Int_BufSz = Int_BufSz + 1 ! NStepWave Int_BufSz = Int_BufSz + 1 ! NStepWave2 @@ -1812,31 +1772,6 @@ SUBROUTINE SeaSt_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%MSL2SWL Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElevC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElevC,3), UBOUND(InData%WaveElevC,3) - DO i2 = LBOUND(InData%WaveElevC,2), UBOUND(InData%WaveElevC,2) - DO i1 = LBOUND(InData%WaveElevC,1), UBOUND(InData%WaveElevC,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF ReKiBuf(Re_Xferred) = InData%WaveDirMin Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%WaveDirMax @@ -1847,21 +1782,6 @@ SUBROUTINE SeaSt_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_Xferred = Int_Xferred + 1 ReKiBuf(Re_Xferred) = InData%WaveDOmega Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) - ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF ReKiBuf(Re_Xferred) = InData%RhoXg Re_Xferred = Re_Xferred + 1 IntKiBuf(Int_Xferred) = InData%NStepWave @@ -2058,34 +1978,7 @@ SUBROUTINE SeaSt_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, OutData%MSL2SWL = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 NULLIFY(OutData%WaveElevC0) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevC)) DEALLOCATE(OutData%WaveElevC) - ALLOCATE(OutData%WaveElevC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElevC,3), UBOUND(OutData%WaveElevC,3) - DO i2 = LBOUND(OutData%WaveElevC,2), UBOUND(OutData%WaveElevC,2) - DO i1 = LBOUND(OutData%WaveElevC,1), UBOUND(OutData%WaveElevC,1) - OutData%WaveElevC(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF + NULLIFY(OutData%WaveElevC) NULLIFY(OutData%WaveDirArr) OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) Re_Xferred = Re_Xferred + 1 @@ -2107,24 +2000,7 @@ SUBROUTINE SeaSt_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, NULLIFY(OutData%PWaveVel0) NULLIFY(OutData%WaveElev1) NULLIFY(OutData%WaveElev2) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev0)) DEALLOCATE(OutData%WaveElev0) - ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) - OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF + NULLIFY(OutData%WaveElev0) NULLIFY(OutData%WaveTime) OutData%RhoXg = REAL(ReKiBuf(Re_Xferred), SiKi) Re_Xferred = Re_Xferred + 1 diff --git a/modules/seastate/src/UserWaves.f90 b/modules/seastate/src/UserWaves.f90 index 7ec9a733b7..122dde24af 100644 --- a/modules/seastate/src/UserWaves.f90 +++ b/modules/seastate/src/UserWaves.f90 @@ -56,8 +56,8 @@ SUBROUTINE Initial_InitOut_Arrays(InitOut, WaveField, InitInp, WaveDT, ErrStat, ErrMsg = "" ! Allocatable arrays: - ALLOCATE ( InitOut%WaveElev0 ( 0:InitOut%NStepWave ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElev0.', ErrStat, ErrMsg, RoutineName) - ALLOCATE ( InitOut%WaveElevC (2, 0:InitOut%NStepWave2, InitInp%NGrid(1)*InitInp%NGrid(2) ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElevC.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveField%WaveElev0 ( 0:InitOut%NStepWave ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElev0.', ErrStat, ErrMsg, RoutineName) + ALLOCATE ( WaveField%WaveElevC (2, 0:InitOut%NStepWave2, InitInp%NGrid(1)*InitInp%NGrid(2) ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElevC.', ErrStat,ErrMsg,RoutineName) ! Allocatable arrays in WaveField: ALLOCATE ( WaveField%WaveTime ( 0:InitOut%NStepWave ) , STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveTime.', ErrStat, ErrMsg, RoutineName) @@ -83,9 +83,8 @@ SUBROUTINE Initial_InitOut_Arrays(InitOut, WaveField, InitInp, WaveDT, ErrStat, WaveField%WaveTime(I) = I * WaveDT END DO ! I - All time steps - InitOut%WaveElev0 = 0.0 - InitOut%WaveElevC = 0.0 - + WaveField%WaveElev0 = 0.0 + WaveField%WaveElevC = 0.0 WaveField%WaveElevC0 = 0.0 WaveField%WaveElev1 = 0.0 WaveField%WaveDynP = 0.0 diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index da9b3102fe..4bc80285c3 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -1158,7 +1158,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Compute the inverse discrete Fourier transforms to find the time-domain ! representations of the wave kinematics without stretcing: - CALL ApplyFFT_cx ( InitOut%WaveElev0 (0:InitOut%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) + CALL ApplyFFT_cx ( WaveField%WaveElev0 (0:InitOut%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() @@ -1170,7 +1170,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) 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), InitOut%WaveElevC(:,:,k), tmpComplexArr, ErrStatTmp, ErrMsgTmp ) ! Note this sets 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() @@ -1483,7 +1483,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! ENDSELECT ! Set the ending timestep to the same as the first timestep - InitOut%WaveElev0 (InitOut%NStepWave) = InitOut%WaveElev0 (0 ) + WaveField%WaveElev0 (InitOut%NStepWave) = WaveField%WaveElev0 (0 ) WaveField%WaveDynP (InitOut%NStepWave,:,:,: ) = WaveField%WaveDynP (0,:,:,: ) WaveField%WaveVel (InitOut%NStepWave,:,:,:,:) = WaveField%WaveVel (0,:,:,:,:) WaveField%WaveAcc (InitOut%NStepWave,:,:,:,:) = WaveField%WaveAcc (0,:,:,:,:) @@ -2437,13 +2437,13 @@ SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddA ! Compute the crest height based on the current guess of crest elevation tmpComplexArr = CMPLX( WaveField%WaveElevC0(1,:) + Crest * tmpArr, & WaveField%WaveElevC0(2,:)) - CALL ApplyFFT_cx ( InitOut%WaveElev0 (0:InitOut%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) + CALL ApplyFFT_cx ( WaveField%WaveElev0 (0:InitOut%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveElev0.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN ! Find the preceding or following trough, whichever is lower - Trough = MIN(MINVAL(InitOut%WaveElev0(1:MIN(NStepTp,InitOut%NStepWave-1))), & - MINVAL(InitOut%WaveElev0(MAX(InitOut%NStepWave-NStepTp,0):InitOut%NStepWave-1))) + Trough = MIN(MINVAL(WaveField%WaveElev0(1:MIN(NStepTp,InitOut%NStepWave-1))), & + MINVAL(WaveField%WaveElev0(MAX(InitOut%NStepWave-NStepTp,0):InitOut%NStepWave-1))) CrestHeight = Crest-Trough CrestHeightError = ABS(CrestHeight - InitInp%CrestHmax) ! print *, CrestHeight @@ -2452,14 +2452,14 @@ SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddA ! Compute the crest height based on a slightly nudged crest elevation tmpComplexArr = CMPLX( WaveField%WaveElevC0(1,:) + (Crest+CrestHeightTol) * tmpArr, & WaveField%WaveElevC0(2,:)) - CALL ApplyFFT_cx ( InitOut%WaveElev0 (0:InitOut%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) + CALL ApplyFFT_cx ( WaveField%WaveElev0 (0:InitOut%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveElev0.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN ! Find the preceding or following trough, whichever is lower - Trough = MIN(MINVAL(InitOut%WaveElev0(1:MIN(NStepTp,InitOut%NStepWave-1))), & - MINVAL(InitOut%WaveElev0(MAX(InitOut%NStepWave-NStepTp,0):InitOut%NStepWave-1))) + Trough = MIN(MINVAL(WaveField%WaveElev0(1:MIN(NStepTp,InitOut%NStepWave-1))), & + MINVAL(WaveField%WaveElev0(MAX(InitOut%NStepWave-NStepTp,0):InitOut%NStepWave-1))) CrestHeight1 = Crest+CrestHeightTol-Trough ! Update crest elevation with Newton-Raphson Method Crest = Crest - (CrestHeight-InitInp%CrestHmax)*CrestHeightTol/(CrestHeight1-CrestHeight) From f3217939d091c7e582902951f12e8ca008256efb Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Mon, 5 Jun 2023 23:53:53 -0600 Subject: [PATCH 07/12] Fix SeaStOut_WrSummaryFile to use WaveField --- modules/seastate/src/SeaState_Output.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/seastate/src/SeaState_Output.f90 b/modules/seastate/src/SeaState_Output.f90 index 5755317c60..79bc15c467 100644 --- a/modules/seastate/src/SeaState_Output.f90 +++ b/modules/seastate/src/SeaState_Output.f90 @@ -1104,7 +1104,7 @@ SUBROUTINE SeaStOut_WrSummaryFile(InitInp, InputFileData, p, Waves_InitOut, ErrS DO I = -1*Waves_InitOut%NStepWave2+1,Waves_InitOut%NStepWave2 WaveNmbr = WaveNumber ( I*Waves_InitOut%WaveDOmega, InitInp%Gravity, InputFileData%Waves%WtrDpth ) WRITE( UnSum, '(1X,I10,2X,ES14.5,2X,ES14.5,2X,ES14.5,2X,ES14.5,7X,ES14.5)' ) I, WaveNmbr, I*Waves_InitOut%WaveDOmega, & - Waves_InitOut%WaveDirArr(ABS(I)), Waves_InitOut%WaveElevC0( 1,ABS(I ) ) , Waves_InitOut%WaveElevC0( 2, ABS(I ) )*SIGN(1,I) + p%WaveField%WaveDirArr(ABS(I)), p%WaveField%WaveElevC0( 1,ABS(I ) ) , p%WaveField%WaveElevC0( 2, ABS(I ) )*SIGN(1,I) END DO END IF From 93e986aea56ad2b052fe0bd998d73661d03278c7 Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Tue, 6 Jun 2023 09:59:14 -0600 Subject: [PATCH 08/12] Update Waves2_Init to use WaveField --- modules/seastate/src/SeaState.f90 | 7 +-- modules/seastate/src/Waves2.f90 | 78 ++++++++++++++++--------------- 2 files changed, 42 insertions(+), 43 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index e575efbf1e..91dd0e054c 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -298,11 +298,8 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InputFileData%Waves2%WaveTime => p%WaveTime InputFileData%Waves2%WaveElevC0 => Waves_InitOut%WaveElevC0 InputFileData%Waves2%WaveDirArr => Waves_InitOut%WaveDirArr - - CALL Waves2_Init(InputFileData%Waves2, p%Waves2, Waves2_InitOut, ErrStat2, ErrMsg2 ) - ALLOCATE ( p%WaveField%WaveElev2 (0:InputFileData%Waves2%NStepWave,InputFileData%Waves2%NGrid(1),InputFileData%Waves2%NGrid(2) ) , STAT=ErrStat2 ) - IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array p%WaveField%WaveElev2.', ErrStat,ErrMsg,RoutineName) - p%WaveField%WaveElev2 = Waves2_InitOut%WaveElev2 + + CALL Waves2_Init(InputFileData%Waves2, p%Waves2, Waves2_InitOut, p%WaveField, ErrStat2, ErrMsg2 ) p%WaveElev2 => p%WaveField%WaveElev2 ! do this before calling cleanup() so that pointers get deallocated properly CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) diff --git a/modules/seastate/src/Waves2.f90 b/modules/seastate/src/Waves2.f90 index c72629c228..9b84aa2138 100644 --- a/modules/seastate/src/Waves2.f90 +++ b/modules/seastate/src/Waves2.f90 @@ -36,6 +36,7 @@ MODULE Waves2 USE NWTC_Library USE NWTC_FFTPACK USE Waves, ONLY : WaveNumber, ImagNmbr + USE SeaSt_WaveField_Types IMPLICIT NONE @@ -58,12 +59,13 @@ MODULE Waves2 !> @brief !! This routine is called at the start of the simulation to perform initialization steps. !! The parameters that are set here are not changed during the simulation. -SUBROUTINE Waves2_Init( InitInp, p, InitOut, ErrStat, ErrMsg ) +SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(Waves2_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine TYPE(Waves2_ParameterType), INTENT( OUT) :: p !< Parameters TYPE(Waves2_InitOutputType), INTENT( OUT) :: InitOut !< Output for initialization routine + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField !< WaveFieldType INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -245,11 +247,11 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, ErrStat, ErrMsg ) ! Check that WaveElevC0 is a 2x(NStepWave2+1) sized array (0 index start) - IF ( SIZE( InitInp%WaveElevC0, DIM=2 ) /= (InitInp%NStepWave2 + 1) ) THEN ! Expect a 2x(0:NStepWave2) array + IF ( SIZE( WaveField%WaveElevC0, DIM=2 ) /= (InitInp%NStepWave2 + 1) ) THEN ! Expect a 2x(0:NStepWave2) array CALL SetErrStat( ErrID_Fatal, ' Programming error in call to Waves2_Init:'//NewLine// & ' --> Expected array for WaveElevC0 to be of size 2x'//TRIM(Num2LStr(InitInp%NStepWave2 + 1))// & ' (2x(NStepWave2+1)), but instead received array of size '// & - TRIM(Num2LStr(SIZE(InitInp%WaveElevC0,1)))//'x'//TRIM(Num2LStr(SIZE(InitInp%WaveElevC0,2)))//'.', & + TRIM(Num2LStr(SIZE(WaveField%WaveElevC0,1)))//'x'//TRIM(Num2LStr(SIZE(WaveField%WaveElevC0,2)))//'.', & ErrStat, ErrMsg, RoutineName) CALL CleanUp RETURN @@ -258,11 +260,11 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, ErrStat, ErrMsg ) ! Check that WaveTime is of size (NStepWave+1) - IF ( SIZE( InitInp%WaveTime ) /= (InitInp%NStepWave + 1) ) THEN ! Expect a 2x(0:NStepWave2) array + IF ( SIZE( WaveField%WaveTime ) /= (InitInp%NStepWave + 1) ) THEN ! Expect a 2x(0:NStepWave2) array CALL SetErrStat( ErrID_Fatal, ' Programming error in call to Waves2_Init:'//NewLine// & ' --> Expected array for WaveTime to be of size '//TRIM(Num2LStr(InitInp%NStepWave + 1))// & ' (NStepWave+1), but instead received array of size '// & - TRIM(Num2LStr(SIZE(InitInp%WaveTime)))//'.', & + TRIM(Num2LStr(SIZE(WaveField%WaveTime)))//'.', & ErrStat, ErrMsg, RoutineName) CALL CleanUp RETURN @@ -289,7 +291,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, ErrStat, ErrMsg ) END IF DO I=0,InitInp%NStepWave2 - WaveElevC0Norm(I) = CMPLX( InitInp%WaveElevC0(1,I), InitInp%WaveElevC0(2,I), SiKi ) / REAL(InitInp%NStepWave2,SiKi) + WaveElevC0Norm(I) = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I), SiKi ) / REAL(InitInp%NStepWave2,SiKi) ENDDO !-------------------------------------------------------------------------------- @@ -382,9 +384,8 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, ErrStat, ErrMsg ) !-------------------------------------------------------------------------------- ! Setup the output arrays !-------------------------------------------------------------------------------- - - ALLOCATE ( InitOut%WaveElev2 (0:InitInp%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElev2.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveField%WaveElev2 (0:InitInp%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ) , STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElev2.', ErrStat,ErrMsg,RoutineName) ALLOCATE ( InitOut%WaveVel2D (0:InitInp%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveVel2D.', ErrStat,ErrMsg,RoutineName) @@ -410,9 +411,10 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, ErrStat, ErrMsg ) RETURN END IF + !InitOut%WaveElev2 => WaveField%WaveElev2 !Initialize the output arrays to zero. We will only fill it in for the points we calculate. - InitOut%WaveElev2 = 0.0_SiKi + WaveField%WaveElev2 = 0.0_SiKi InitOut%WaveVel2D = 0.0_SiKi InitOut%WaveAcc2D = 0.0_SiKi InitOut%WaveDynP2D = 0.0_SiKi @@ -545,12 +547,12 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, ErrStat, ErrMsg ) i = mod(k-1, InitInp%NGrid(1)) + 1 j = (k-1) / InitInp%NGrid(1) + 1 CALL WaveElevTimeSeriesAtXY_Diff(InitInp%WaveKinGridxi(k), InitInp%WaveKinGridyi(k), TmpTimeSeries, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to InitOut%WaveElev2.',ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveField%WaveElev2.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() RETURN END IF - InitOut%WaveElev2(:,I,J) = TmpTimeSeries(:) + WaveField%WaveElev2(:,I,J) = TmpTimeSeries(:) ENDDO ! Wave elevation points requested @@ -606,8 +608,8 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, ErrStat, ErrMsg ) !! + \left( |\vec{k_n}| \sin \theta_n - |\vec{k_m}| sin \theta_m \right) ~ y \right] \right) \f$ WaveElevxyPrime0 = exp( - ImagNmbr & - * ( ( k_n * COS( D2R_S*InitInp%WaveDirArr(n) ) - k_m * COS( D2R_S*InitInp%WaveDirArr(m) ) ) * InitInp%WaveKinGridxi(masterCount) & - + ( k_n * SIN( D2R_S*InitInp%WaveDirArr(n) ) - k_m * SIN( D2R_S*InitInp%WaveDirArr(m) ) ) * InitInp%WaveKinGridyi(masterCount) )) + * ( ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) - k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) * InitInp%WaveKinGridxi(masterCount) & + + ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) - k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) * InitInp%WaveKinGridyi(masterCount) )) ! Get value for \f$ B^- \f$ for the n,m index pair @@ -617,10 +619,10 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, ErrStat, ErrMsg ) !> Calculate \f$ U^- \f$ terms for the velocity calculations (\f$B^-\f$ provided by waves2::transfuncb_minus) ! NOTE: InitInp%WtrDpth + WaveKinzi0Prime(I) is the height above the ocean floor !> * \f$ _x{U}_{nm}^- = B_{nm}^- \left(k_n \cos \theta_n - k_m \cos \theta_m \right) \f$ - Ux_nm_minus = B_minus * ( k_n * COS( D2R_S*InitInp%WaveDirArr(n) ) - k_m * COS( D2R_S*InitInp%WaveDirArr(m) ) ) + Ux_nm_minus = B_minus * ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) - k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) !> * \f$ _y{U}_{nm}^- = B_{nm}^- \left(k_n \sin \theta_n - k_m \sin \theta_m \right) \f$ - Uy_nm_minus = B_minus * ( k_n * SIN( D2R_S*InitInp%WaveDirArr(n) ) - k_m * SIN( D2R_S*InitInp%WaveDirArr(m) ) ) + Uy_nm_minus = B_minus * ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) - k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) !> * \f$ _z{U}_{nm}^- = \imath B_{nm}^- k_{nm} \tanh \left( k_{nm} ( h + z ) \right) \f$ Uz_nm_minus = ImagNmbr * B_minus * k_nm * tanh( k_nm * ( InitInp%WtrDpth + WaveKinzi0Prime(I) ) ) @@ -908,13 +910,13 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, ErrStat, ErrMsg ) i = mod(k-1, InitInp%NGrid(1)) + 1 j = (k-1) / InitInp%NGrid(1) + 1 CALL WaveElevTimeSeriesAtXY_Sum(InitInp%WaveKinGridxi(k), InitInp%WaveKinGridyi(k), TmpTimeSeries, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to InitOut%WaveElev2.',ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveField%WaveElev2.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() RETURN END IF ! Add to the series since the difference is already included - InitOut%WaveElev2(:,I,J) = InitOut%WaveElev2(:,I,J) + TmpTimeSeries(:) + WaveField%WaveElev2(:,I,J) = WaveField%WaveElev2(:,I,J) + TmpTimeSeries(:) ENDDO ! Wave elevation points requested !-------------------------------------------------------------------------------- @@ -981,8 +983,8 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, ErrStat, ErrMsg ) !! + |\vec{k_n}| \sin \theta_n ~ y \right] \right) \f$ WaveElevxyPrime0 = exp( - ImagNmbr & - * ( 2.0_SiKi * k_n * COS( D2R_S*InitInp%WaveDirArr(n) ) * InitInp%WaveKinGridxi(masterCount) & - + 2.0_SiKi * k_n * SIN( D2R_S*InitInp%WaveDirArr(n) ) * InitInp%WaveKinGridyi(masterCount) )) + * ( 2.0_SiKi * k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) * InitInp%WaveKinGridxi(masterCount) & + + 2.0_SiKi * k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) * InitInp%WaveKinGridyi(masterCount) )) ! Get value for \f$ B+ \f$ for the n,m index pair @@ -992,10 +994,10 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, ErrStat, ErrMsg ) !> Calculate \f$ U^+ \f$ terms for the velocity calculations (\f$B^+\f$ provided by waves2::transfuncb_plus) ! NOTE: InitInp%WtrDpth + WaveKinzi0Prime(I) is the height above the ocean floor !> * \f$ _x{U}_{nn}^+ = B_{nn}^+ 2 k_n \cos \theta_n \f$ - Ux_nm_plus = B_plus * 2.0_SiKi * k_n * COS( D2R_S*InitInp%WaveDirArr(n) ) + Ux_nm_plus = B_plus * 2.0_SiKi * k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) !> * \f$ _y{U}_{nn}^+ = B_{nn}^+ 2 k_n \sin \theta_n \f$ - Uy_nm_plus = B_plus * 2.0_SiKi * k_n * SIN( D2R_S*InitInp%WaveDirArr(n) ) + Uy_nm_plus = B_plus * 2.0_SiKi * k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) !> * \f$ _z{U}_{nn}^+ = \imath B_{nn}^+ k_{nn} \tanh \left( k_{nn} ( h + z ) \right) \f$ Uz_nm_plus = ImagNmbr * B_plus * k_nm * tanh( k_nm * ( InitInp%WtrDpth + WaveKinzi0Prime(I) ) ) @@ -1083,8 +1085,8 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, ErrStat, ErrMsg ) !! + \left( |\vec{k_n}| \sin \theta_n + |\vec{k_m}| sin \theta_m \right) ~ y \right] \right) \f$ WaveElevxyPrime0 = exp( - ImagNmbr & - * ( ( k_n * COS( D2R_S*InitInp%WaveDirArr(n) ) + k_m * COS( D2R_S*InitInp%WaveDirArr(m) ) ) * InitInp%WaveKinGridxi(masterCount) & - + ( k_n * SIN( D2R_S*InitInp%WaveDirArr(n) ) + k_m * SIN( D2R_S*InitInp%WaveDirArr(m) ) ) * InitInp%WaveKinGridyi(masterCount) )) + * ( ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) + k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) * InitInp%WaveKinGridxi(masterCount) & + + ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) + k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) * InitInp%WaveKinGridyi(masterCount) )) ! Get value for \f$ B+ \f$ for the n,m index pair @@ -1094,10 +1096,10 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, ErrStat, ErrMsg ) !> Calculate \f$ U^+ \f$ terms for the velocity calculations (\f$B^+\f$ provided by waves2::transfuncb_plus) ! NOTE: InitInp%WtrDpth + WaveKinzi0Prime(I) is the height above the ocean floor !> * \f$ _x{U}_{nm}^+ = B_{nm}^+ \left(k_n \cos \theta_n + k_m \cos \theta_m \right) \f$ - Ux_nm_plus = B_plus * ( k_n * COS( D2R_S*InitInp%WaveDirArr(n) ) + k_m * COS( D2R_S*InitInp%WaveDirArr(m) ) ) + Ux_nm_plus = B_plus * ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) + k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) !> * \f$ _y{U}_{nm}^+ = B_{nm}^+ \left(k_n \sin \theta_n + k_m \sin \theta_m \right) \f$ - Uy_nm_plus = B_plus * ( k_n * SIN( D2R_S*InitInp%WaveDirArr(n) ) + k_m * SIN( D2R_S*InitInp%WaveDirArr(m) ) ) + Uy_nm_plus = B_plus * ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) + k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) !> * \f$ _z{U}_{nm}^+ = \imath B_{nm}^+ k_{nm} \tanh \left( k_{nm} ( h + z ) \right) \f$ Uz_nm_plus = ImagNmbr * B_plus * k_nm * tanh( k_nm * ( InitInp%WtrDpth + WaveKinzi0Prime(I) ) ) @@ -1379,7 +1381,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Diff(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrSta !! !! The value of \f$ D^-_{nm} \f$ is found from by the ::TransFuncD_minus routine. - L_minus = (( D_minus - k_n * k_m * COS(D2R_S*InitInp%WaveDirArr(n) - D2R_S*InitInp%WaveDirArr(m)) - R_n * R_m )/SQRT( R_n * R_m ) + R_n + R_m) / 4.0_SiKi !4.0_SiKi + L_minus = (( D_minus - k_n * k_m * COS(D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m)) - R_n * R_m )/SQRT( R_n * R_m ) + R_n + R_m) / 4.0_SiKi !4.0_SiKi ! Calculate the terms \f$ n,m \f$ necessary for calculations @@ -1393,8 +1395,8 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Diff(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrSta !! + \left( |\vec{k_n}| \sin \theta_n - |\vec{k_m}| sin \theta_m \right) ~ y \right] \right) \f$ WaveElevxyPrime0 = exp( - ImagNmbr & - * ( ( k_n * COS( D2R_S*InitInp%WaveDirArr(n) ) - k_m * COS( D2R_S*InitInp%WaveDirArr(m) ) ) * XCoord & - + ( k_n * SIN( D2R_S*InitInp%WaveDirArr(n) ) - k_m * SIN( D2R_S*InitInp%WaveDirArr(m) ) ) * YCoord )) + * ( ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) - k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) * XCoord & + + ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) - k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) * YCoord )) !> ### Calculate the inner summation \f$ H^-(\omega_{\mu^-}) \f$ terms for the velocity, acceleration, and pressure. ### @@ -1515,8 +1517,8 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat !! + |\vec{k_n}| \sin \theta_n ~ y \right] \right) \f$ WaveElevxyPrime0 = exp( - ImagNmbr & - * ( 2.0_SiKi * k_n * COS( D2R_S*InitInp%WaveDirArr(n) ) * XCoord & - + 2.0_SiKi * k_n * SIN( D2R_S*InitInp%WaveDirArr(n) ) * YCoord )) + * ( 2.0_SiKi * k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) * XCoord & + + 2.0_SiKi * k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) * YCoord )) ! First get the wave amplitude -- must be reconstructed from the WaveElevC0 array. First index is the real (1) or ! imaginary (2) part. Divide by NStepWave2 to remove the built in normalization in WaveElevC0. Note that the phase @@ -1571,7 +1573,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat !! + (R_n+R_m) \right] \f$ !! !! The value of \f$ D^-_{nm} \f$ is found from by the ::TransFuncD_plus routine. - L_plus = (( D_plus - k_n * k_m * COS(D2R_S*InitInp%WaveDirArr(n) - D2R_S*InitInp%WaveDirArr(m)) + R_n * R_m )/SQRT( R_n * R_m ) + R_n + R_m) / 4.0_SiKi + L_plus = (( D_plus - k_n * k_m * COS(D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m)) + R_n * R_m )/SQRT( R_n * R_m ) + R_n + R_m) / 4.0_SiKi !> Calculate the dot product of the wavenumbers with the (x,y) location !! This is given by: @@ -1582,8 +1584,8 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat !! + \left( |\vec{k_n}| \sin \theta_n + |\vec{k_m}| sin \theta_m \right) ~ y \right] \right) \f$ WaveElevxyPrime0 = exp( - ImagNmbr & - * ( ( k_n * COS( D2R_S*InitInp%WaveDirArr(n) ) + k_m * COS( D2R_S*InitInp%WaveDirArr(m) ) ) * XCoord & - + ( k_n * SIN( D2R_S*InitInp%WaveDirArr(n) ) + k_m * SIN( D2R_S*InitInp%WaveDirArr(m) ) ) * YCoord )) + * ( ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) + k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) * XCoord & + + ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) + k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) * YCoord )) @@ -1863,7 +1865,7 @@ FUNCTION TransFuncD_minus(n,m,k_n,k_m,R_n,R_m) ! Calculate the two pieces of the numerator Num1 = SqrtRnMinusRm * ( SQRT(R_m) * ( k_n*k_n - R_n*R_n ) - SQRT(R_n) * ( k_m*k_m - R_m*R_m ) ) - Num2 = 2*SqrtRnMinusRm*SqrtRnMinusRm*( k_n * k_m * COS( D2R_S*InitInp%WaveDirArr(n) - D2R_S*InitInp%WaveDirArr(m) ) + R_n*R_m ) + Num2 = 2*SqrtRnMinusRm*SqrtRnMinusRm*( k_n * k_m * COS( D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m) ) + R_n*R_m ) ! Calculate the denominator Den = SqrtRnMinusRm*SqrtRnMinusRm - k_nm * tanh( k_nm * InitInp%WtrDpth ) @@ -1927,7 +1929,7 @@ FUNCTION TransFuncD_plus(n,m,k_n,k_m,R_n,R_m) ! Calculate the two pieces of the numerator Num1 = SqrtRnPlusRm * ( SQRT(R_m) * ( k_n*k_n - R_n*R_n ) + SQRT(R_n) * ( k_m*k_m - R_m*R_m ) ) - Num2 = 2*SqrtRnPlusRm*SqrtRnPlusRm*( k_n * k_m * COS( D2R_S*InitInp%WaveDirArr(n) - D2R_S*InitInp%WaveDirArr(m) ) - R_n*R_m ) + Num2 = 2*SqrtRnPlusRm*SqrtRnPlusRm*( k_n * k_m * COS( D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m) ) - R_n*R_m ) ! Calculate the denominator Den = SqrtRnPlusRm*SqrtRnPlusRm - k_nm * tanh( k_nm * InitInp%WtrDpth ) @@ -1961,7 +1963,7 @@ FUNCTION k_nm_minus(n,m,k_n,k_m) k_nm_minus = 0.0_SiKi ! This is just to eliminate any numerical error ELSE !bjj: added abs() because we were getting very small negative numbers here (which should be 0). - k_nm_minus = sqrt( abs( k_n * k_n + k_m * k_m - 2 * k_n * k_m * cos( D2R_S*InitInp%WaveDirArr(n) - D2R_S*InitINp%WaveDirArr(m) ) ) ) + k_nm_minus = sqrt( abs( k_n * k_n + k_m * k_m - 2 * k_n * k_m * cos( D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m) ) ) ) ENDIF END FUNCTION k_nm_minus @@ -1986,7 +1988,7 @@ FUNCTION k_nm_plus(n,m,k_n,k_m) IF (n == m ) THEN k_nm_plus = 2.0_SiKi * k_n ! This is just to eliminate any numerical error. ELSE - k_nm_plus = sqrt( k_n * k_n + k_m * k_m + 2_SiKi * k_n * k_m * cos( D2R_S*InitInp%WaveDirArr(n) - D2R_S*InitINp%WaveDirArr(m) ) ) + k_nm_plus = sqrt( k_n * k_n + k_m * k_m + 2_SiKi * k_n * k_m * cos( D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m) ) ) ENDIF END FUNCTION k_nm_plus From 62f2d9b75d0e80228a0b77efeacc25ddf5546404 Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Wed, 7 Jun 2023 13:55:47 -0600 Subject: [PATCH 09/12] Force the hydrostatic load calculation with MHstLMod=2 to be in double precision --- modules/hydrodyn/src/Morison.f90 | 175 +++++++++++--------- modules/openfast-library/src/FAST_Types.f90 | 2 +- modules/openfoam/src/OpenFOAM_Types.f90 | 10 +- reg_tests/r-test | 2 +- 4 files changed, 100 insertions(+), 89 deletions(-) diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 155eaf4e1a..247c866037 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -2642,7 +2642,8 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, REAL(ReKi) :: WtrDpth REAL(ReKi) :: FAMCFFSInt(3) INTEGER(IntKi) :: MemSubStat, NumFSX - REAL(ReKi) :: theta1, theta2, dFdl(6), y_hat(3), z_hat(3), posMid(3), zetaMid, FSPt(3) + REAL(DbKi) :: theta1, theta2 + REAL(ReKi) :: y_hat(3), z_hat(3), posMid(3), zetaMid, FSPt(3) INTEGER(IntKi) :: secStat LOGICAL :: Is1stElement @@ -3786,7 +3787,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, n_hat = (/0.0,0.0,1.0/) END IF CALL GetSectionUnitVectors( k_hat1, y_hat, z_hat ) - CALL GetSectionFreeSurfaceIntersects( pos1, FSPt, k_hat1, y_hat, z_hat, n_hat, r1, theta1, theta2, secStat) + CALL GetSectionFreeSurfaceIntersects( REAL(pos1,DbKi), REAL(FSPt,DbKi), k_hat1, y_hat, z_hat, n_hat, REAL(r1,DbKi), theta1, theta2, secStat) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL GetEndPlateHstLds(pos1, k_hat1, y_hat, z_hat, r1, theta1, theta2, F_B_End) m%F_B_End(:, mem%NodeIndx( 1)) = m%F_B_End(:, mem%NodeIndx( 1)) + F_B_End @@ -3807,7 +3808,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, n_hat = (/0.0,0.0,1.0/) END IF CALL GetSectionUnitVectors( k_hat2, y_hat, z_hat ) - CALL GetSectionFreeSurfaceIntersects( pos2, FSPt, k_hat2, y_hat, z_hat, n_hat, r2, theta1, theta2, secStat) + CALL GetSectionFreeSurfaceIntersects( REAL(pos2,DbKi), REAL(FSPt,DbKi), k_hat2, y_hat, z_hat, n_hat, REAL(r2,DbKi), theta1, theta2, secStat) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL GetEndPlateHstLds(pos2, k_hat2, y_hat, z_hat, r2, theta1, theta2, F_B_End) m%F_B_End(:, mem%NodeIndx(N+1)) = m%F_B_End(:, mem%NodeIndx(N+1)) - F_B_End @@ -3829,7 +3830,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, n_hat = (/0.0,0.0,1.0/) END IF CALL GetSectionUnitVectors( k_hat2, y_hat, z_hat ) - CALL GetSectionFreeSurfaceIntersects( pos2, FSPt, k_hat2, y_hat, z_hat, n_hat, r2, theta1, theta2, secStat) + CALL GetSectionFreeSurfaceIntersects( REAL(pos2,DbKi), REAL(FSPt,DbKi), k_hat2, y_hat, z_hat, n_hat, REAL(r2,DbKi), theta1, theta2, secStat) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL GetEndPlateHstLds(pos2, k_hat2, y_hat, z_hat, r2, theta1, theta2, F_B_End) m%F_B_End(:, mem%NodeIndx(N+1)) = m%F_B_End(:, mem%NodeIndx(N+1)) - F_B_End @@ -3996,19 +3997,19 @@ SUBROUTINE GetSectionUnitVectors( k, y, z ) END SUBROUTINE GetSectionUnitVectors SUBROUTINE GetSectionFreeSurfaceIntersects( pos0, FSPt, k_hat, y_hat, z_hat, n_hat, R, theta1, theta2, secStat) - REAL(ReKi), INTENT( In ) :: pos0(3) - REAL(ReKi), INTENT( In ) :: FSPt(3) + REAL(DbKi), INTENT( In ) :: pos0(3) + REAL(DbKi), INTENT( In ) :: FSPt(3) REAL(ReKi), INTENT( In ) :: k_hat(3) REAL(ReKi), INTENT( In ) :: y_hat(3) REAL(ReKi), INTENT( In ) :: z_hat(3) REAL(ReKi), INTENT( In ) :: n_hat(3) - REAL(ReKi), INTENT( In ) :: R - REAL(ReKi), INTENT( OUT ) :: theta1 - REAL(ReKi), INTENT( OUT ) :: theta2 + REAL(DbKi), INTENT( In ) :: R + REAL(DbKi), INTENT( OUT ) :: theta1 + REAL(DbKi), INTENT( OUT ) :: theta2 INTEGER(IntKi), INTENT( OUT ) :: secStat - REAL(ReKi) :: a, b, c, d, d2 - REAL(ReKi) :: alpha, beta - REAL(ReKi) :: tmp + REAL(DbKi) :: a, b, c, d, d2 + REAL(DbKi) :: alpha, beta + REAL(DbKi) :: tmp CHARACTER(*), PARAMETER :: RoutineName = 'GetSectionFreeSurfaceIntersects' a = R * dot_product(y_hat,n_hat) @@ -4045,18 +4046,18 @@ END SUBROUTINE GetSectionFreeSurfaceIntersects SUBROUTINE GetSectionHstLds( origin, pos0, k_hat, y_hat, z_hat, R, dRdl, theta1, theta2, dFdl) - REAL(ReKi), INTENT( IN ) :: origin(3) - REAL(ReKi), INTENT( IN ) :: pos0(3) - REAL(ReKi), INTENT( IN ) :: k_hat(3) - REAL(ReKi), INTENT( IN ) :: y_hat(3) - REAL(ReKi), INTENT( IN ) :: z_hat(3) - REAL(ReKi), INTENT( IN ) :: R - REAL(ReKi), INTENT( IN ) :: dRdl - REAL(ReKi), INTENT( IN ) :: theta1 - REAL(ReKi), INTENT( IN ) :: theta2 - REAL(ReKi), INTENT( OUT ) :: dFdl(6) - REAL(ReKi) :: C0, C1, C2 - REAL(ReKi) :: Z0, dTheta, sinTheta1, sinTheta2, cosTheta1, cosTheta2, cosPhi + REAL(DbKi), INTENT( IN ) :: origin(3) + REAL(DbKi), INTENT( IN ) :: pos0(3) + REAL(DbKi), INTENT( IN ) :: k_hat(3) + REAL(DbKi), INTENT( IN ) :: y_hat(3) + REAL(DbKi), INTENT( IN ) :: z_hat(3) + REAL(DbKi), INTENT( IN ) :: R + REAL(DbKi), INTENT( IN ) :: dRdl + REAL(DbKi), INTENT( IN ) :: theta1 + REAL(DbKi), INTENT( IN ) :: theta2 + REAL(DbKi), INTENT( OUT ) :: dFdl(6) + REAL(DbKi) :: C0, C1, C2 + REAL(DbKi) :: Z0, dTheta, sinTheta1, sinTheta2, cosTheta1, cosTheta2, cosPhi Z0 = pos0(3) dTheta = theta2 - theta1 @@ -4076,25 +4077,25 @@ SUBROUTINE GetSectionHstLds( origin, pos0, k_hat, y_hat, z_hat, R, dRdl, theta1, END SUBROUTINE GetSectionHstLds - SUBROUTINE getElementHstLds_Mod2( pos1In, pos2In, FSPt, k_hat, y_hat, z_hat, n_hat, r1, r2, dl, F_B1, F_B2, ErrStat, ErrMsg ) + SUBROUTINE getElementHstLds_Mod2( pos1In, pos2In, FSPtIn, k_hatIn, y_hatIn, z_hatIn, n_hatIn, r1In, r2In, dlIn, F_B1, F_B2, ErrStat, ErrMsg ) REAL(ReKi), INTENT( IN ) :: pos1In(3) REAL(ReKi), INTENT( IN ) :: pos2In(3) - REAL(ReKi), INTENT( IN ) :: FSPt(3) - REAL(ReKi), INTENT( IN ) :: k_hat(3) - REAL(ReKi), INTENT( IN ) :: y_hat(3) - REAL(ReKi), INTENT( IN ) :: z_hat(3) - REAL(ReKi), INTENT( IN ) :: n_hat(3) - REAL(ReKi), INTENT( IN ) :: r1 - REAL(ReKi), INTENT( IN ) :: r2 - REAL(ReKi), INTENT( IN ) :: dl + REAL(ReKi), INTENT( IN ) :: FSPtIn(3) + REAL(ReKi), INTENT( IN ) :: k_hatIn(3) + REAL(ReKi), INTENT( IN ) :: y_hatIn(3) + REAL(ReKi), INTENT( IN ) :: z_hatIn(3) + REAL(ReKi), INTENT( IN ) :: n_hatIn(3) + REAL(ReKi), INTENT( IN ) :: r1In + REAL(ReKi), INTENT( IN ) :: r2In + REAL(ReKi), INTENT( IN ) :: dlIn REAL(ReKi), INTENT( OUT ) :: F_B1(6) REAL(ReKi), INTENT( OUT ) :: F_B2(6) INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None - REAL(ReKi) :: dRdl, theta1, theta2 - REAL(ReKi) :: dFdl1(6), dFdlMid(6), dFdl2(6), F_B(6) - REAL(ReKi) :: i, rMid, posMid(3), pos1(3), pos2(3) + REAL(DbKi) :: theta1, theta2 + REAL(DbKi) :: dFdl1(6), dFdlMid(6), dFdl2(6), F_B(6) + REAL(DbKi) :: i, dl, r1, r2, rMid, dRdl, posMid(3), pos1(3), pos2(3), FSPt(3), k_hat(3), y_hat(3), z_hat(3), n_hat(3) INTEGER(IntKi) :: secStat1, secStatMid, secStat2 CHARACTER(*), PARAMETER :: routineName = "getElementHstLds_Mod2" INTEGER(IntKi) :: errStat2 @@ -4102,35 +4103,43 @@ SUBROUTINE getElementHstLds_Mod2( pos1In, pos2In, FSPt, k_hat, y_hat, z_hat, n_h ErrStat = ErrID_None ErrMsg = "" - pos1 = pos1In - pos2 = pos2In + pos1 = REAL(pos1In,DbKi) + pos2 = REAL(pos2In,DbKi) + r1 = REAL(r1In,DbKi) + r2 = REAL(r2In,DbKi) + dl = REAL(dlIn,DbKi) dRdl = (r2-r1)/dl rMid = 0.5*( r1+ r2) posMid = 0.5*(pos1In+pos2In) + FSPt = REAL(FSPtIn,DbKi) + k_hat = REAL(k_hatIn,DbKi) + y_hat = REAL(y_hatIn,DbKi) + z_hat = REAL(z_hatIn,DbKi) + n_hat = REAL(n_hatIn,DbKi) ! Avoid sections coincident with the SWL IF ( ABS(k_hat(3)) > 0.999999_ReKi ) THEN ! Vertical member - IF ( EqualRealNos( pos1In(3), 0.0 ) ) THEN - pos1(3) = pos1In(3) - 1.0E-6 * dl + IF ( EqualRealNos( pos1(3), 0.0_DbKi ) ) THEN + pos1(3) = pos1(3) - 1.0E-6 * dl END IF - IF ( EqualRealNos( pos2In(3), 0.0 ) ) THEN - pos2(3) = pos2In(3) - 1.0E-6 * dl + IF ( EqualRealNos( pos2(3), 0.0_DbKi ) ) THEN + pos2(3) = pos2(3) - 1.0E-6 * dl END IF - IF ( EqualRealNos( posMid(3), 0.0 ) ) THEN + IF ( EqualRealNos( posMid(3), 0.0_DbKi ) ) THEN posMid(3) = posMid(3) - 1.0E-6 * dl END IF END IF ! Section load at node 1 - CALL GetSectionFreeSurfaceIntersects( pos1, FSPt, k_hat, y_hat, z_hat, n_hat, r1, theta1, theta2, secStat1) + CALL GetSectionFreeSurfaceIntersects( pos1, FSPt, REAL(k_hat,ReKi), REAL(y_hat,ReKi), REAL(z_hat,ReKi), REAL(n_hat,ReKi), r1, theta1, theta2, secStat1) CALL GetSectionHstLds( pos1, pos1, k_hat, y_hat, z_hat, r1, dRdl, theta1, theta2, dFdl1) ! Section load at midpoint - CALL GetSectionFreeSurfaceIntersects( posMid, FSPt, k_hat, y_hat, z_hat, n_hat, rMid, theta1, theta2, secStatMid) + CALL GetSectionFreeSurfaceIntersects( posMid, FSPt, REAL(k_hat,ReKi), REAL(y_hat,ReKi), REAL(z_hat,ReKi), REAL(n_hat,ReKi), rMid, theta1, theta2, secStatMid) CALL GetSectionHstLds( pos1, posMid, k_hat, y_hat, z_hat, rMid, dRdl, theta1, theta2, dFdlMid) ! Section load at node 2 - CALL GetSectionFreeSurfaceIntersects( pos2, FSPt, k_hat, y_hat, z_hat, n_hat, r2, theta1, theta2, secStat2) + CALL GetSectionFreeSurfaceIntersects( pos2, FSPt, REAL(k_hat,ReKi), REAL(y_hat,ReKi), REAL(z_hat,ReKi), REAL(n_hat,ReKi), r2, theta1, theta2, secStat2) CALL GetSectionHstLds( pos1, pos2, k_hat, y_hat, z_hat, r2, dRdl, theta1, theta2, dFdl2) ! Adaptively refine the load integration over the element @@ -4148,39 +4157,41 @@ END SUBROUTINE getElementHstLds_Mod2 RECURSIVE SUBROUTINE RefineElementHstLds( origin, pos1, posMid, pos2, FSPt, r1, rMid, r2, dl, dRdl,secStat1,secStatMid,secStat2, k_hat, y_hat, z_hat, n_hat, dFdl1, dFdlMid, dFdl2, recurLvl, F_B_5pt, ErrStat, ErrMsg) - REAL(ReKi), INTENT( IN ) :: origin(3) - REAL(ReKi), INTENT( IN ) :: pos1(3) - REAL(ReKi), INTENT( IN ) :: posMid(3) - REAL(ReKi), INTENT( IN ) :: pos2(3) - REAL(ReKi), INTENT( IN ) :: FSPt(3) - REAL(ReKi), INTENT( IN ) :: r1 - REAL(ReKi), INTENT( IN ) :: rMid - REAL(ReKi), INTENT( IN ) :: r2 - REAL(ReKi), INTENT( IN ) :: dl - REAL(ReKi), INTENT( IN ) :: dRdl + REAL(DbKi), INTENT( IN ) :: origin(3) + REAL(DbKi), INTENT( IN ) :: pos1(3) + REAL(DbKi), INTENT( IN ) :: posMid(3) + REAL(DbKi), INTENT( IN ) :: pos2(3) + REAL(DbKi), INTENT( IN ) :: FSPt(3) + REAL(DbKi), INTENT( IN ) :: r1 + REAL(DbKi), INTENT( IN ) :: rMid + REAL(DbKi), INTENT( IN ) :: r2 + REAL(DbKi), INTENT( IN ) :: dl + REAL(DbKi), INTENT( IN ) :: dRdl INTEGER(IntKi), INTENT( IN ) :: secStat1 INTEGER(IntKi), INTENT( IN ) :: secStatMid INTEGER(IntKi), INTENT( IN ) :: secStat2 - REAL(ReKi), INTENT( IN ) :: k_hat(3) - REAL(ReKi), INTENT( IN ) :: y_hat(3) - REAL(ReKi), INTENT( IN ) :: z_hat(3) - REAL(ReKi), INTENT( IN ) :: n_hat(3) - REAL(ReKi), INTENT( IN ) :: dFdl1(6) - REAL(ReKi), INTENT( IN ) :: dFdlMid(6) - REAL(ReKi), INTENT( IN ) :: dFdl2(6) + REAL(DbKi), INTENT( IN ) :: k_hat(3) + REAL(DbKi), INTENT( IN ) :: y_hat(3) + REAL(DbKi), INTENT( IN ) :: z_hat(3) + REAL(DbKi), INTENT( IN ) :: n_hat(3) + REAL(DbKi), INTENT( IN ) :: dFdl1(6) + REAL(DbKi), INTENT( IN ) :: dFdlMid(6) + REAL(DbKi), INTENT( IN ) :: dFdl2(6) INTEGER(IntKi), INTENT( IN ) :: recurLvl - REAL(ReKi), INTENT( OUT ) :: F_B_5pt(6) + REAL(DbKi), INTENT( OUT ) :: F_B_5pt(6) INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None - REAL(ReKi) :: posMidL(3), posMidR(3), rMidL, rMidR, F_B_3pt(6) - REAL(ReKi) :: dFdlMidL(6), dFdlMidR(6) - REAL(ReKi) :: error(6), tmp(6) + REAL(DbKi) :: theta1,theta2 + REAL(DbKi) :: posMidL(3), posMidR(3) + REAL(DbKi) :: rMidL, rMidR + REAL(DbKi) :: dFdlMidL(6), dFdlMidR(6), F_B_3pt(6) + REAL(DbKi) :: error(6), tmp(6) LOGICAL :: refine, tolMet INTEGER(IntKi) :: i INTEGER(IntKi) :: secStatMidL, secStatMidR - REAL(ReKi), PARAMETER :: RelTol = 1.0E-6 - REAL(ReKi), PARAMETER :: AbsTol = 1.0E-8 + REAL(DbKi), PARAMETER :: RelTol = 1.0E-6 + REAL(DbKi), PARAMETER :: AbsTol = 1.0E-8 INTEGER(IntKi), PARAMETER :: maxRecurLvl = 50 CHARACTER(*), PARAMETER :: RoutineName = "RefineElementHstLds" @@ -4194,10 +4205,10 @@ RECURSIVE SUBROUTINE RefineElementHstLds( origin, pos1, posMid, pos2, FSPt, r1, ! Avoid sections coincident with the SWL IF ( ABS(k_hat(3)) > 0.999999_ReKi ) THEN ! Vertical member - IF ( EqualRealNos( posMidL(3), 0.0 ) ) THEN + IF ( EqualRealNos( posMidL(3), 0.0_DbKi ) ) THEN posMidL(3) = posMidL(3) - 1.0E-6 * dl END IF - IF ( EqualRealNos( posMidR(3), 0.0 ) ) THEN + IF ( EqualRealNos( posMidR(3), 0.0_DbKi ) ) THEN posMidR(3) = posMidR(3) - 1.0E-6 * dl END IF END IF @@ -4206,11 +4217,11 @@ RECURSIVE SUBROUTINE RefineElementHstLds( origin, pos1, posMid, pos2, FSPt, r1, F_B_3pt = (dFdl1 + 4.0*dFdlMid + dFdl2) * dl/6.0 ! Mid point of left section - CALL GetSectionFreeSurfaceIntersects( posMidL, FSPt, k_hat, y_hat, z_hat, n_hat, rMidL, theta1, theta2, secStatMidL) + CALL GetSectionFreeSurfaceIntersects( posMidL, FSPt, REAL(k_hat,ReKi), REAL(y_hat,ReKi), REAL(z_hat,ReKi), REAL(n_hat,ReKi), rMidL, theta1, theta2, secStatMidL) CALL GetSectionHstLds( origin, posMidL, k_hat, y_hat, z_hat, rMidL, dRdl, theta1, theta2, dFdlMidL) ! Mid point of right section - CALL GetSectionFreeSurfaceIntersects( posMidR, FSPt, k_hat, y_hat, z_hat, n_hat, rMidR, theta1, theta2, secStatMidR) + CALL GetSectionFreeSurfaceIntersects( posMidR, FSPt, REAL(k_hat,ReKi), REAL(y_hat,ReKi), REAL(z_hat,ReKi), REAL(n_hat,ReKi), rMidR, theta1, theta2, secStatMidR) CALL GetSectionHstLds( origin, posMidR, k_hat, y_hat, z_hat, rMidR, dRdl, theta1, theta2, dFdlMidR) F_B_5pt = (dFdl1 + 4.0*dFdlMidL + 2.0*dFdlMid + 4.0*dFdlMidR + dFdl2) * dl/12.0 @@ -4250,16 +4261,16 @@ SUBROUTINE GetEndPlateHstLds(pos0, k_hat, y_hat, z_hat, R, theta1, theta2, F) REAL(ReKi), INTENT( IN ) :: y_hat(3) REAL(ReKi), INTENT( IN ) :: z_hat(3) REAL(ReKi), INTENT( IN ) :: R - REAL(ReKi), INTENT( IN ) :: theta1 - REAL(ReKi), INTENT( IN ) :: theta2 + REAL(DbKi), INTENT( IN ) :: theta1 + REAL(DbKi), INTENT( IN ) :: theta2 REAL(ReKi), INTENT( OUT ) :: F(6) - REAL(ReKi) :: C0, C1, C2, a, b, tmp1, tmp2, tmp3 - REAL(ReKi) :: Z0, cosPhi, dTheta - REAL(ReKi) :: y1, y2 - REAL(ReKi) :: z1, z2, z1_2, z2_2, z1_3, z2_3, z1_4, z2_4 - REAL(ReKi) :: dy, dy_3, dz, dz_2, dz_3, dz_4, sz - REAL(ReKi) :: R_2, R_4 - REAL(ReKi) :: Fk, My, Mz + REAL(DbKi) :: C0, C1, C2, a, b, tmp1, tmp2, tmp3 + REAL(DbKi) :: Z0, cosPhi, dTheta + REAL(DbKi) :: y1, y2 + REAL(DbKi) :: z1, z2, z1_2, z2_2, z1_3, z2_3, z1_4, z2_4 + REAL(DbKi) :: dy, dy_3, dz, dz_2, dz_3, dz_4, sz + REAL(DbKi) :: R_2, R_4 + REAL(DbKi) :: Fk, My, Mz Z0 = pos0(3) cosPhi = SQRT(k_hat(1)**2+k_hat(2)**2) diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 7a2b73f8f1..63893b4018 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -775,7 +775,7 @@ MODULE FAST_Types CHARACTER(1024) :: RootName !< Root name of FAST output files (overrides normal operation) [-] INTEGER(IntKi) :: NumActForcePtsBlade !< number of actuator line force points in blade [-] INTEGER(IntKi) :: NumActForcePtsTower !< number of actuator line force points in tower [-] - INTEGER(IntKi) :: NodeClusterType !< Node clustering for actuator line (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] + LOGICAL :: NodeClusterType !< Node clustering for actuator line (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] END TYPE FAST_ExternInitType ! ======================= ! ========= FAST_TurbineType ======= diff --git a/modules/openfoam/src/OpenFOAM_Types.f90 b/modules/openfoam/src/OpenFOAM_Types.f90 index a3a92c86e5..3613f4b483 100644 --- a/modules/openfoam/src/OpenFOAM_Types.f90 +++ b/modules/openfoam/src/OpenFOAM_Types.f90 @@ -104,7 +104,7 @@ MODULE OpenFOAM_Types REAL(KIND=C_FLOAT) :: BladeLength REAL(KIND=C_FLOAT) :: TowerHeight REAL(KIND=C_FLOAT) :: TowerBaseHeight - LOGICAL(KIND=C_BOOL) :: NodeClusterType + INTEGER(KIND=C_INT) :: NodeClusterType END TYPE OpFM_ParameterType_C TYPE, PUBLIC :: OpFM_ParameterType TYPE( OpFM_ParameterType_C ) :: C_obj @@ -419,7 +419,7 @@ SUBROUTINE OpFM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%TowerBaseHeight Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%NodeClusterType, IntKiBuf(1)) + IntKiBuf(Int_Xferred) = InData%NodeClusterType Int_Xferred = Int_Xferred + 1 END SUBROUTINE OpFM_PackInitInput @@ -507,7 +507,7 @@ SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight - OutData%NodeClusterType = TRANSFER(IntKiBuf(Int_Xferred), OutData%NodeClusterType) + OutData%NodeClusterType = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%C_obj%NodeClusterType = OutData%NodeClusterType END SUBROUTINE OpFM_UnPackInitInput @@ -1957,7 +1957,7 @@ SUBROUTINE OpFM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%TowerBaseHeight Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%NodeClusterType, IntKiBuf(1)) + IntKiBuf(Int_Xferred) = InData%NodeClusterType Int_Xferred = Int_Xferred + 1 END SUBROUTINE OpFM_PackParam @@ -2060,7 +2060,7 @@ SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight - OutData%NodeClusterType = TRANSFER(IntKiBuf(Int_Xferred), OutData%NodeClusterType) + OutData%NodeClusterType = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%C_obj%NodeClusterType = OutData%NodeClusterType END SUBROUTINE OpFM_UnPackParam diff --git a/reg_tests/r-test b/reg_tests/r-test index 46105ab128..95e2af3fac 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 46105ab128f6dbe8e4c97f61934db89a11075cb3 +Subproject commit 95e2af3fac290a5fa2c0078566950faf88cd7792 From 8d91aa8870a286de8fa89ec5ddc99e0e12a26e5e Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Wed, 7 Jun 2023 15:07:35 -0600 Subject: [PATCH 10/12] Replace PI with PI_D to be consistent with theta1 and theta2 in double precision --- modules/hydrodyn/src/Morison.f90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 247c866037..ebb96c0448 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -3792,7 +3792,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, CALL GetEndPlateHstLds(pos1, k_hat1, y_hat, z_hat, r1, theta1, theta2, F_B_End) m%F_B_End(:, mem%NodeIndx( 1)) = m%F_B_End(:, mem%NodeIndx( 1)) + F_B_End IF (mem%MHstLMod == 1) THEN ! Check for partially wetted end plates - IF ( (theta2-theta1)/=0.0 .AND. (theta2-theta1)/=2.0*PI) THEN + IF ( .NOT.( EqualRealNos((theta2-theta1),0.0_DbKi) .OR. EqualRealNos((theta2-theta1),2.0_DbKi*PI_D) ) ) THEN CALL SetErrStat(ErrID_Warn, 'End plate is partially wetted with MHstLMod = 1. The buoyancy load and distribution potentially have large error. This has happened to the first node of Member ID ' //trim(num2lstr(mem%MemberID)), errStat, errMsg, RoutineName ) END IF END IF @@ -3813,7 +3813,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, CALL GetEndPlateHstLds(pos2, k_hat2, y_hat, z_hat, r2, theta1, theta2, F_B_End) m%F_B_End(:, mem%NodeIndx(N+1)) = m%F_B_End(:, mem%NodeIndx(N+1)) - F_B_End IF (mem%MHstLMod == 1) THEN ! Check for partially wetted end plates - IF ( (theta2-theta1)/=0.0 .AND. (theta2-theta1)/=2.0*PI) THEN + IF ( .NOT.( EqualRealNos((theta2-theta1),0.0_DbKi) .OR. EqualRealNos((theta2-theta1),2.0_DbKi*PI_D) ) ) THEN CALL SetErrStat(ErrID_Warn, 'End plate is partially wetted with MHstLMod = 1. The buoyancy load and distribution potentially have large error. This has happened to the last node of Member ID ' //trim(num2lstr(mem%MemberID)), errStat, errMsg, RoutineName ) END IF END IF @@ -3835,7 +3835,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, CALL GetEndPlateHstLds(pos2, k_hat2, y_hat, z_hat, r2, theta1, theta2, F_B_End) m%F_B_End(:, mem%NodeIndx(N+1)) = m%F_B_End(:, mem%NodeIndx(N+1)) - F_B_End IF (mem%MHstLMod == 1) THEN ! Check for partially wetted end plates - IF ( (theta2-theta1)/=0.0 .AND. (theta2-theta1)/=2.0*PI) THEN + IF ( .NOT.( EqualRealNos((theta2-theta1),0.0_DbKi) .OR. EqualRealNos((theta2-theta1),2.0_DbKi*PI_D) ) ) THEN CALL SetErrStat(ErrID_Warn, 'End plate is partially wetted with MHstLMod = 1. The buoyancy load and distribution potentially have large error. This has happened to the last node of Member ID ' //trim(num2lstr(mem%MemberID)), errStat, errMsg, RoutineName ) END IF END IF @@ -4029,16 +4029,16 @@ SUBROUTINE GetSectionFreeSurfaceIntersects( pos0, FSPt, k_hat, y_hat, z_hat, n_h IF ( dot_product( (cos(theta2)-cos(theta1))*z_hat-(sin(theta2)-sin(theta1))*y_hat, n_hat) < 0.0 ) THEN tmp = theta1 theta1 = theta2 - theta2 = tmp + 2.0*PI + theta2 = tmp + 2.0*PI_D END IF secStat = 1; ELSE IF (c > 0.0) THEN ! Section is fully submerged - theta1 = -1.5*PI - theta2 = 0.5*PI + theta1 = -1.5*PI_D + theta2 = 0.5*PI_D secStat = 2; ELSE ! Section is completely dry - theta1 = -0.5*PI - theta2 = -0.5*PI + theta1 = -0.5*PI_D + theta2 = -0.5*PI_D secStat = 0; END IF From aecafc3150f1378baf835244723df0dcc27e3b2a Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Wed, 7 Jun 2023 15:21:31 -0600 Subject: [PATCH 11/12] OpFM: fix inconsistent typing of NodeCluster in FAST_Types --- modules/openfast-library/src/FAST_Registry.txt | 2 +- modules/openfast-library/src/FAST_Types.f90 | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index c2205023e7..f69948e8e8 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -755,7 +755,7 @@ typedef ^ FAST_ExternInitType ReKi windGrid_pZero 3 - - "fixed position of the X typedef ^ FAST_ExternInitType CHARACTER(1024) RootName - - - "Root name of FAST output files (overrides normal operation)" - typedef ^ FAST_ExternInitType IntKi NumActForcePtsBlade - - - "number of actuator line force points in blade" - typedef ^ FAST_ExternInitType IntKi NumActForcePtsTower - - - "number of actuator line force points in tower" - -typedef ^ FAST_ExternInitType logical NodeClusterType - - - "Node clustering for actuator line (0 - Uniform, 1 - Non-uniform clustered towards tip)" - +typedef ^ FAST_ExternInitType IntKi NodeClusterType - - - "Node clustering for actuator line (0 - Uniform, 1 - Non-uniform clustered towards tip)" - # ..... FAST Turbine Data (one realization) ....................................................................................................... typedef ^ FAST_TurbineType IntKi TurbID - 1 - "Turbine ID Number" - diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 63893b4018..dc07024dcd 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -775,7 +775,7 @@ MODULE FAST_Types CHARACTER(1024) :: RootName !< Root name of FAST output files (overrides normal operation) [-] INTEGER(IntKi) :: NumActForcePtsBlade !< number of actuator line force points in blade [-] INTEGER(IntKi) :: NumActForcePtsTower !< number of actuator line force points in tower [-] - LOGICAL :: NodeClusterType !< Node clustering for actuator line (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] + INTEGER(IntKi) :: NodeClusterType !< Node clustering for actuator line (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] END TYPE FAST_ExternInitType ! ======================= ! ========= FAST_TurbineType ======= @@ -48870,7 +48870,7 @@ SUBROUTINE FAST_PackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%NumActForcePtsTower Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%NodeClusterType, IntKiBuf(1)) + IntKiBuf(Int_Xferred) = InData%NodeClusterType Int_Xferred = Int_Xferred + 1 END SUBROUTINE FAST_PackExternInitType @@ -48987,7 +48987,7 @@ SUBROUTINE FAST_UnPackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Xferred = Int_Xferred + 1 OutData%NumActForcePtsTower = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - OutData%NodeClusterType = TRANSFER(IntKiBuf(Int_Xferred), OutData%NodeClusterType) + OutData%NodeClusterType = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 END SUBROUTINE FAST_UnPackExternInitType From 03d20c027c0bd8307bc853ebf479d1c7fd2cae3c Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Thu, 8 Jun 2023 13:56:12 -0600 Subject: [PATCH 12/12] SeaState and HydroDyn coupling and registry cleanup --- modules/hydrodyn/src/Current_Types.f90 | 1946 ------------------ modules/hydrodyn/src/HydroDyn.txt | 30 +- modules/hydrodyn/src/HydroDyn_C_Binding.f90 | 21 +- modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 20 +- modules/hydrodyn/src/WAMIT.txt | 3 - modules/openfast-library/src/FAST_Subs.f90 | 20 - modules/seastate/src/SeaState.txt | 3 - 7 files changed, 3 insertions(+), 2040 deletions(-) delete mode 100644 modules/hydrodyn/src/Current_Types.f90 diff --git a/modules/hydrodyn/src/Current_Types.f90 b/modules/hydrodyn/src/Current_Types.f90 deleted file mode 100644 index cd0b3ac2e7..0000000000 --- a/modules/hydrodyn/src/Current_Types.f90 +++ /dev/null @@ -1,1946 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'Current_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 -!********************************************************************************************************************************* -! Current_Types -!................................................................................................................................. -! This file is part of Current. -! -! 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 Current. 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 Current_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE NWTC_Library -IMPLICIT NONE -! ========= Current_InitInputType ======= - TYPE, PUBLIC :: Current_InitInputType - REAL(SiKi) :: CurrSSV0 !< [-] - CHARACTER(80) :: CurrSSDirChr !< [-] - REAL(SiKi) :: CurrSSDir !< [-] - REAL(SiKi) :: CurrNSRef !< [-] - REAL(SiKi) :: CurrNSV0 !< [-] - REAL(SiKi) :: CurrNSDir !< [-] - REAL(SiKi) :: CurrDIV !< [-] - REAL(SiKi) :: CurrDIDir !< [-] - INTEGER(IntKi) :: CurrMod !< [-] - REAL(SiKi) :: WtrDpth !< [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: MorisonNodezi !< [-] - INTEGER(IntKi) :: NMorisonNodes !< [-] - CHARACTER(1024) :: DirRoot !< [-] - END TYPE Current_InitInputType -! ======================= -! ========= Current_InitOutputType ======= - TYPE, PUBLIC :: Current_InitOutputType - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVxi !< [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVyi !< [-] - REAL(SiKi) :: PCurrVxiPz0 !< [-] - REAL(SiKi) :: PCurrVyiPz0 !< [-] - END TYPE Current_InitOutputType -! ======================= -! ========= Current_ContinuousStateType ======= - TYPE, PUBLIC :: Current_ContinuousStateType - REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] - END TYPE Current_ContinuousStateType -! ======================= -! ========= Current_DiscreteStateType ======= - TYPE, PUBLIC :: Current_DiscreteStateType - REAL(SiKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] - END TYPE Current_DiscreteStateType -! ======================= -! ========= Current_ConstraintStateType ======= - TYPE, PUBLIC :: Current_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] - END TYPE Current_ConstraintStateType -! ======================= -! ========= Current_OtherStateType ======= - TYPE, PUBLIC :: Current_OtherStateType - INTEGER(IntKi) :: DummyOtherState !< Remove this variable if you have other states [-] - END TYPE Current_OtherStateType -! ======================= -! ========= Current_MiscVarType ======= - TYPE, PUBLIC :: Current_MiscVarType - REAL(ReKi) :: DummyMiscVar !< Remove this variable if you have misc/optimization variables [-] - END TYPE Current_MiscVarType -! ======================= -! ========= Current_ParameterType ======= - TYPE, PUBLIC :: Current_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration and discrete state update [seconds] - END TYPE Current_ParameterType -! ======================= -! ========= Current_InputType ======= - TYPE, PUBLIC :: Current_InputType - REAL(SiKi) :: DummyInput !< Remove this variable if you have input data [-] - END TYPE Current_InputType -! ======================= -! ========= Current_OutputType ======= - TYPE, PUBLIC :: Current_OutputType - REAL(SiKi) :: DummyOutput !< Remove this variable if you have output data [-] - END TYPE Current_OutputType -! ======================= -CONTAINS - SUBROUTINE Current_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Current_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%CurrSSV0 = SrcInitInputData%CurrSSV0 - DstInitInputData%CurrSSDirChr = SrcInitInputData%CurrSSDirChr - DstInitInputData%CurrSSDir = SrcInitInputData%CurrSSDir - DstInitInputData%CurrNSRef = SrcInitInputData%CurrNSRef - DstInitInputData%CurrNSV0 = SrcInitInputData%CurrNSV0 - DstInitInputData%CurrNSDir = SrcInitInputData%CurrNSDir - DstInitInputData%CurrDIV = SrcInitInputData%CurrDIV - DstInitInputData%CurrDIDir = SrcInitInputData%CurrDIDir - DstInitInputData%CurrMod = SrcInitInputData%CurrMod - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth -IF (ALLOCATED(SrcInitInputData%MorisonNodezi)) THEN - i1_l = LBOUND(SrcInitInputData%MorisonNodezi,1) - i1_u = UBOUND(SrcInitInputData%MorisonNodezi,1) - IF (.NOT. ALLOCATED(DstInitInputData%MorisonNodezi)) THEN - ALLOCATE(DstInitInputData%MorisonNodezi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MorisonNodezi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%MorisonNodezi = SrcInitInputData%MorisonNodezi -ENDIF - DstInitInputData%NMorisonNodes = SrcInitInputData%NMorisonNodes - DstInitInputData%DirRoot = SrcInitInputData%DirRoot - END SUBROUTINE Current_CopyInitInput - - SUBROUTINE Current_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(Current_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%MorisonNodezi)) THEN - DEALLOCATE(InitInputData%MorisonNodezi) -ENDIF - END SUBROUTINE Current_DestroyInitInput - - SUBROUTINE Current_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Current_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! CurrSSV0 - Int_BufSz = Int_BufSz + 1*LEN(InData%CurrSSDirChr) ! CurrSSDirChr - Re_BufSz = Re_BufSz + 1 ! CurrSSDir - Re_BufSz = Re_BufSz + 1 ! CurrNSRef - Re_BufSz = Re_BufSz + 1 ! CurrNSV0 - Re_BufSz = Re_BufSz + 1 ! CurrNSDir - Re_BufSz = Re_BufSz + 1 ! CurrDIV - Re_BufSz = Re_BufSz + 1 ! CurrDIDir - Int_BufSz = Int_BufSz + 1 ! CurrMod - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! MorisonNodezi allocated yes/no - IF ( ALLOCATED(InData%MorisonNodezi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MorisonNodezi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MorisonNodezi) ! MorisonNodezi - END IF - Int_BufSz = Int_BufSz + 1 ! NMorisonNodes - Int_BufSz = Int_BufSz + 1*LEN(InData%DirRoot) ! DirRoot - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%CurrSSV0 - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%CurrSSDirChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%CurrSSDirChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%CurrSSDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CurrNSRef - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CurrNSV0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CurrNSDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CurrDIV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CurrDIDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CurrMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%MorisonNodezi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MorisonNodezi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MorisonNodezi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MorisonNodezi,1), UBOUND(InData%MorisonNodezi,1) - ReKiBuf(Re_Xferred) = InData%MorisonNodezi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NMorisonNodes - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%DirRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE Current_PackInitInput - - SUBROUTINE Current_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Current_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%CurrSSV0 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%CurrSSDirChr) - OutData%CurrSSDirChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CurrSSDir = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrNSRef = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrNSV0 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrNSDir = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrDIV = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrDIDir = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MorisonNodezi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MorisonNodezi)) DEALLOCATE(OutData%MorisonNodezi) - ALLOCATE(OutData%MorisonNodezi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonNodezi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MorisonNodezi,1), UBOUND(OutData%MorisonNodezi,1) - OutData%MorisonNodezi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NMorisonNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%DirRoot) - OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE Current_UnPackInitInput - - SUBROUTINE Current_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Current_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%CurrVxi)) THEN - i1_l = LBOUND(SrcInitOutputData%CurrVxi,1) - i1_u = UBOUND(SrcInitOutputData%CurrVxi,1) - IF (.NOT. ALLOCATED(DstInitOutputData%CurrVxi)) THEN - ALLOCATE(DstInitOutputData%CurrVxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CurrVxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%CurrVxi = SrcInitOutputData%CurrVxi -ENDIF -IF (ALLOCATED(SrcInitOutputData%CurrVyi)) THEN - i1_l = LBOUND(SrcInitOutputData%CurrVyi,1) - i1_u = UBOUND(SrcInitOutputData%CurrVyi,1) - IF (.NOT. ALLOCATED(DstInitOutputData%CurrVyi)) THEN - ALLOCATE(DstInitOutputData%CurrVyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CurrVyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%CurrVyi = SrcInitOutputData%CurrVyi -ENDIF - DstInitOutputData%PCurrVxiPz0 = SrcInitOutputData%PCurrVxiPz0 - DstInitOutputData%PCurrVyiPz0 = SrcInitOutputData%PCurrVyiPz0 - END SUBROUTINE Current_CopyInitOutput - - SUBROUTINE Current_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(Current_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%CurrVxi)) THEN - DEALLOCATE(InitOutputData%CurrVxi) -ENDIF -IF (ALLOCATED(InitOutputData%CurrVyi)) THEN - DEALLOCATE(InitOutputData%CurrVyi) -ENDIF - END SUBROUTINE Current_DestroyInitOutput - - SUBROUTINE Current_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Current_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! CurrVxi allocated yes/no - IF ( ALLOCATED(InData%CurrVxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CurrVxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CurrVxi) ! CurrVxi - END IF - Int_BufSz = Int_BufSz + 1 ! CurrVyi allocated yes/no - IF ( ALLOCATED(InData%CurrVyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CurrVyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CurrVyi) ! CurrVyi - END IF - Re_BufSz = Re_BufSz + 1 ! PCurrVxiPz0 - Re_BufSz = Re_BufSz + 1 ! PCurrVyiPz0 - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%CurrVxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CurrVxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CurrVxi,1), UBOUND(InData%CurrVxi,1) - ReKiBuf(Re_Xferred) = InData%CurrVxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CurrVyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CurrVyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CurrVyi,1), UBOUND(InData%CurrVyi,1) - ReKiBuf(Re_Xferred) = InData%CurrVyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%PCurrVxiPz0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PCurrVyiPz0 - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_PackInitOutput - - SUBROUTINE Current_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Current_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVxi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CurrVxi)) DEALLOCATE(OutData%CurrVxi) - ALLOCATE(OutData%CurrVxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CurrVxi,1), UBOUND(OutData%CurrVxi,1) - OutData%CurrVxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVyi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CurrVyi)) DEALLOCATE(OutData%CurrVyi) - ALLOCATE(OutData%CurrVyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CurrVyi,1), UBOUND(OutData%CurrVyi,1) - OutData%CurrVyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%PCurrVxiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%PCurrVyiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_UnPackInitOutput - - SUBROUTINE Current_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(Current_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE Current_CopyContState - - SUBROUTINE Current_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(Current_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Current_DestroyContState - - SUBROUTINE Current_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Current_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyContState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_PackContState - - SUBROUTINE Current_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Current_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_UnPackContState - - SUBROUTINE Current_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(Current_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE Current_CopyDiscState - - SUBROUTINE Current_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(Current_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Current_DestroyDiscState - - SUBROUTINE Current_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Current_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyDiscState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_PackDiscState - - SUBROUTINE Current_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Current_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_UnPackDiscState - - SUBROUTINE Current_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(Current_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE Current_CopyConstrState - - SUBROUTINE Current_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(Current_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Current_DestroyConstrState - - SUBROUTINE Current_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Current_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_PackConstrState - - SUBROUTINE Current_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Current_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_UnPackConstrState - - SUBROUTINE Current_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(Current_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE Current_CopyOtherState - - SUBROUTINE Current_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(Current_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Current_DestroyOtherState - - SUBROUTINE Current_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Current_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! DummyOtherState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Current_PackOtherState - - SUBROUTINE Current_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Current_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Current_UnPackOtherState - - SUBROUTINE Current_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(Current_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar - END SUBROUTINE Current_CopyMisc - - SUBROUTINE Current_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(Current_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Current_DestroyMisc - - SUBROUTINE Current_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Current_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyMiscVar - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_PackMisc - - SUBROUTINE Current_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Current_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyMiscVar = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_UnPackMisc - - SUBROUTINE Current_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Current_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - END SUBROUTINE Current_CopyParam - - SUBROUTINE Current_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(Current_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Current_DestroyParam - - SUBROUTINE Current_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Current_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE Current_PackParam - - SUBROUTINE Current_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Current_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE Current_UnPackParam - - SUBROUTINE Current_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_InputType), INTENT(IN) :: SrcInputData - TYPE(Current_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputData%DummyInput = SrcInputData%DummyInput - END SUBROUTINE Current_CopyInput - - SUBROUTINE Current_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(Current_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Current_DestroyInput - - SUBROUTINE Current_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Current_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyInput - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_PackInput - - SUBROUTINE Current_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Current_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyInput = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_UnPackInput - - SUBROUTINE Current_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_OutputType), INTENT(IN) :: SrcOutputData - TYPE(Current_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOutputData%DummyOutput = SrcOutputData%DummyOutput - END SUBROUTINE Current_CopyOutput - - SUBROUTINE Current_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(Current_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Current_DestroyOutput - - SUBROUTINE Current_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Current_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyOutput - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyOutput - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_PackOutput - - SUBROUTINE Current_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Current_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyOutput = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_UnPackOutput - - - SUBROUTINE Current_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(Current_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(Current_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Current_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL Current_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Current_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL Current_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE Current_Input_ExtrapInterp - - - SUBROUTINE Current_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = u1, f(t2) = u2 -! -!.................................................................................................................................. - - TYPE(Current_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(Current_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(Current_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'Current_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) - b = -(u1%DummyInput - u2%DummyInput) - u_out%DummyInput = u1%DummyInput + b * ScaleFactor - END SUBROUTINE Current_Input_ExtrapInterp1 - - - SUBROUTINE Current_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 -! -!.................................................................................................................................. - - TYPE(Current_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(Current_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(Current_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(Current_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Current_Input_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor - c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor - u_out%DummyInput = u1%DummyInput + b + c * t_out - END SUBROUTINE Current_Input_ExtrapInterp2 - - - SUBROUTINE Current_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(Current_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(Current_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Current_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL Current_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Current_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL Current_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE Current_Output_ExtrapInterp - - - SUBROUTINE Current_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = y1, f(t2) = y2 -! -!.................................................................................................................................. - - TYPE(Current_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(Current_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(Current_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'Current_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) - b = -(y1%DummyOutput - y2%DummyOutput) - y_out%DummyOutput = y1%DummyOutput + b * ScaleFactor - END SUBROUTINE Current_Output_ExtrapInterp1 - - - SUBROUTINE Current_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 -! -!.................................................................................................................................. - - TYPE(Current_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(Current_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(Current_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(Current_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Current_Output_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - b = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))* scaleFactor - c = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) * scaleFactor - y_out%DummyOutput = y1%DummyOutput + b + c * t_out - END SUBROUTINE Current_Output_ExtrapInterp2 - -END MODULE Current_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 59c344d800..203c2d8194 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -14,9 +14,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 Current.txt -#usefrom Waves.txt -#usefrom Waves2.txt usefrom Conv_Radiation.txt usefrom SS_Radiation.txt usefrom SS_Excitation.txt @@ -25,7 +22,6 @@ usefrom WAMIT2.txt usefrom Morison.txt usefrom SeaSt_WaveField.txt usefrom SeaState.txt -#usefrom FIT.txt param HydroDyn/HydroDyn unused INTEGER MaxHDOutputs - 510 - "The maximum number of output channels supported by this module" - param HydroDyn/HydroDyn unused INTEGER MaxUserOutputs - 5150 - " Total possible number of output channels: SS_Excitation = 7 + SS_Radiation = 7 + Morison= 4626 + HydroDyn=510 = 5150" - @@ -39,8 +35,6 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi AddCLin {:}{:}{:} - - "Additional stiffness matrix" - typedef ^ ^ ReKi AddBLin {:}{:}{:} - - "Additional linear damping matrix" - typedef ^ ^ ReKi AddBQuad {:}{:}{:} - - "Additional quadratic damping (drag) matrix" - -#typedef ^ ^ Waves_InitInputType Waves - - - "Initialization data for Waves module" - -#typedef ^ ^ Waves2_InitInputType Waves2 - - - "Initialization data for Waves module" - typedef ^ ^ SeaSt_InitInputType SeaState - - - "Initialization data for SeaState module" - typedef ^ ^ CHARACTER(1024) PotFile {:} - - "The name of the root potential flow file (without extension for WAMIT, complete name for FIT)" - typedef ^ ^ INTEGER nWAMITObj - - - "number of WAMIT input files. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1" - @@ -71,9 +65,7 @@ typedef ^ ^ LOGICAL typedef ^ ^ INTEGER UnSum - - - "File unit for the HydroDyn summary file [-1 = no summary file]" - typedef ^ ^ CHARACTER(20) OutFmt - - - "Output format for numerical results" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "Output format for header strings" - - - - +# typedef HydroDyn/HydroDyn InitInputType CHARACTER(1024) InputFile - - - "Supplied by Driver: full path and filename for the HydroDyn module" - typedef ^ ^ LOGICAL UseInputFile - .TRUE. - "Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller" - typedef ^ ^ FileInfoType PassedFileData - - - "If we don't use the input file, pass everything through this" - @@ -100,27 +92,13 @@ typedef ^ ^ SiKi WvHiCOffD typedef ^ ^ SiKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) -#typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation (points to SeaState module data)" - -#typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation (points to SeaState module data)" - typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) -#typedef ^ ^ SiKi WaveTime {*} - - "Simulation times at which the instantaneous elevation of, velocity of, acceleration of, and loads associated with the incident waves are determined (points to SeaState module data)" (sec) -#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 (points to SeaState module data)" (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 (points to SeaState module data)" (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 (points to SeaState module data)" (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.) (points to SeaState module data)" (m/s) -#typedef ^ ^ SiKi PWaveDynP0 {*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed (points to SeaState module data)" (N/m^2) -#typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "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 (points to SeaState module data)" (m/s^2) -#typedef ^ ^ SiKi PWaveAccMCF0 {*}{*}{*}{*} - - "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 (points to SeaState module data)" (m/s^2) -#typedef ^ ^ SiKi PWaveVel0 {*}{*}{*}{*} - - "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.) (points to SeaState module data)" (m/s) -#typedef ^ ^ SiKi WaveElevC0 {*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part (points to SeaState module data)" (meters) typedef ^ ^ SiKi WaveElevC {:}{:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) -#typedef ^ ^ SiKi WaveDirArr {*} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1 (points to SeaState module data)" (degrees) typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) 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 ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - typedef ^ ^ SiKi MCFD - - - "Diameter of MacCamy-Fuchs members" (meters) typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - # @@ -136,13 +114,10 @@ typedef ^ ^ CHARACTER(L typedef ^ ^ CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - typedef ^ InitOutputType INTEGER DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - - - # ..... HD_ModuleMapType .................................................................................................................... typedef ^ HD_ModuleMapType MeshMapType uW_P_2_PRP_P - - - "Mesh mapping data: WAMIT body kinematics to PRP node at (0,0,0)" - typedef ^ HD_ModuleMapType MeshMapType W_P_2_PRP_P - - - "Mesh mapping data: WAMIT loads to PRP node at (0,0,0)" - typedef ^ HD_ModuleMapType MeshMapType M_P_2_PRP_P - - - "Mesh mapping data: lumped Morison loads to PRP node at (0,0,0)" - - # # # ..... States .................................................................................................................... @@ -167,9 +142,7 @@ typedef ^ ConstraintStateType Morison_Con # Define any other states here: # typedef ^ OtherStateType WAMIT_OtherStateType WAMIT {:} - - "OtherState information from the WAMIT module" - -#typedef ^ OtherStateType FIT_OtherStateType FIT - - - "OtherState information from the FIT module" - typedef ^ ^ Morison_OtherStateType Morison - - - "OtherState information from the Morison module" - - # ..... 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. @@ -194,7 +167,6 @@ typedef ^ ^ INTEGER typedef ^ ^ WAMIT_ParameterType WAMIT {:} - - "Parameter data for the WAMIT module" - typedef ^ ^ WAMIT2_ParameterType WAMIT2 {:} - - "Parameter data for the WAMIT2 module" - typedef ^ ^ LOGICAL WAMIT2used - .FALSE. - "Indicates when WAMIT2 is used. Shortcuts some calculations" - -#typedef ^ ^ FIT_ParameterType FIT - - - "Parameter data for the FIT module" - typedef ^ ^ Morison_ParameterType Morison - - - "Parameter data for the Morison module" - typedef ^ ^ INTEGER PotMod - - - "1 if using WAMIT model, 0 if no potential flow model, or 2 if FIT model" - typedef ^ ^ 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]" - diff --git a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 index 80adcd7b05..287a45116b 100644 --- a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 +++ b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 @@ -425,26 +425,7 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, HD%InitInp%WaveMultiDir = SeaSt%InitOutData%WaveMultiDir HD%InitInp%WaveDOmega = SeaSt%InitOutData%WaveDOmega HD%InitInp%MCFD = SeaSt%InitOutData%MCFD - - ! CALL MOVE_ALLOC( SeaSt%InitOutData%WaveElev0, HD%InitInp%WaveElev0 ) - ! CALL MOVE_ALLOC( SeaSt%InitOutData%WaveElevC, HD%InitInp%WaveElevC ) - ! if(associated(SeaSt%InitOutData%WaveTime )) HD%InitInp%WaveTime => SeaSt%InitOutData%WaveTime - ! if(associated(SeaSt%InitOutData%WaveElevC0)) HD%InitInp%WaveElevC0 => SeaSt%InitOutData%WaveElevC0 - ! if(associated(SeaSt%InitOutData%WaveDirArr)) HD%InitInp%WaveDirArr => SeaSt%InitOutData%WaveDirArr - ! if(associated(SeaSt%InitOutData%WaveElev1 )) HD%InitInp%WaveElev1 => SeaSt%InitOutData%WaveElev1 - ! if(associated(SeaSt%InitOutData%WaveElev2 )) HD%InitInp%WaveElev2 => SeaSt%InitOutData%WaveElev2 - ! if(associated(SeaSt%InitOutData%WaveDynP )) HD%InitInp%WaveDynP => SeaSt%InitOutData%WaveDynP - ! if(associated(SeaSt%InitOutData%WaveAcc )) HD%InitInp%WaveAcc => SeaSt%InitOutData%WaveAcc - ! if(associated(SeaSt%InitOutData%WaveVel )) HD%InitInp%WaveVel => SeaSt%InitOutData%WaveVel - ! if(associated(SeaSt%InitOutData%PWaveDynP0)) HD%InitInp%PWaveDynP0 => SeaSt%InitOutData%PWaveDynP0 - ! if(associated(SeaSt%InitOutData%PWaveAcc0 )) HD%InitInp%PWaveAcc0 => SeaSt%InitOutData%PWaveAcc0 - ! if(associated(SeaSt%InitOutData%PWaveVel0 )) HD%InitInp%PWaveVel0 => SeaSt%InitOutData%PWaveVel0 - ! HD%InitInp%WaveAccMCF => SeaSt%InitOutData%WaveAccMCF - ! HD%InitInp%PWaveAccMCF0 => SeaSt%InitOutData%PWaveAccMCF0 - - ! call SeaSt_Interp_CopyParam(SeaSt%InitOutData%SeaSt_Interp_p, HD%InitInp%SeaSt_Interp_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - ! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + if(associated(SeaSt%InitOutData%WaveField )) HD%InitInp%WaveField => SeaSt%InitOutData%WaveField ! Platform reference position diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index 129f4f95d7..aa09c9bc97 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -346,25 +346,7 @@ subroutine SetHD_InitInputs() InitInData_HD%WaveMultiDir = InitOutData_SeaSt%WaveMultiDir InitInData_HD%WaveDOmega = InitOutData_SeaSt%WaveDOmega InitInData_HD%MCFD = InitOutData_SeaSt%MCFD - - ! InitInData_HD%WaveTime => InitOutData_SeaSt%WaveTime - ! InitInData_HD%WaveElevC0 => InitOutData_SeaSt%WaveElevC0 - ! InitInData_HD%WaveDirArr => InitOutData_SeaSt%WaveDirArr - ! InitInData_HD%WaveElev1 => InitOutData_SeaSt%WaveElev1 - ! InitInData_HD%WaveElev2 => InitOutData_SeaSt%WaveElev2 - ! InitInData_HD%WaveElev0 => InitOutData_SeaSt%WaveElev0 - ! InitInData_HD%WaveDynP => InitOutData_SeaSt%WaveDynP - ! InitInData_HD%WaveAcc => InitOutData_SeaSt%WaveAcc - ! InitInData_HD%WaveVel => InitOutData_SeaSt%WaveVel - ! InitInData_HD%PWaveDynP0 => InitOutData_SeaSt%PWaveDynP0 - ! InitInData_HD%PWaveAcc0 => InitOutData_SeaSt%PWaveAcc0 - ! InitInData_HD%PWaveVel0 => InitOutData_SeaSt%PWaveVel0 - ! InitInData_HD%WaveAccMCF => InitOutData_SeaSt%WaveAccMCF - ! InitInData_HD%PWaveAccMCF0 => InitOutData_SeaSt%PWaveAccMCF0 - ! CALL MOVE_ALLOC( InitOutData_SeaSt%WaveElev0, InitInData_HD%WaveElev0 ) - ! CALL MOVE_ALLOC( InitOutData_SeaSt%WaveElevC, InitInData_HD%WaveElevC ) - ! CALL SeaSt_Interp_CopyParam(InitOutData_SeaSt%SeaSt_Interp_p, InitInData_HD%SeaSt_Interp_p, MESH_NEWCOPY, ErrStat, ErrMsg ); CALL CheckError() - + InitInData_HD%WaveField => InitOutData_SeaSt%WaveField end subroutine SetHD_InitInputs diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index 6024a4e662..9a9d912e56 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 Waves.txt usefrom SeaState_Interp.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]" - @@ -40,8 +39,6 @@ typedef ^ ^ DbKi typedef ^ ^ ReKi WaveDir - - - "" - typedef ^ ^ CHARACTER(1024) WAMITFile - - - "" - typedef ^ ^ Conv_Rdtn_InitInputType Conv_Rdtn - - - "" - -#typedef ^ ^ SS_Rad_InitInputType SS_Rdtn - - - "" - -#typedef ^ ^ SS_Exc_InitInputType SS_Excn - - - "" - typedef ^ ^ ReKi Rhoxg - - - "" - typedef ^ ^ INTEGER NStepWave - - - "" - typedef ^ ^ INTEGER NStepWave2 - - - "" - diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index b1adf40a72..bda3411336 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -824,26 +824,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_HD%WaveMultiDir = Init%OutData_SeaSt%WaveMultiDir Init%InData_HD%WaveDOmega = Init%OutData_SeaSt%WaveDOmega Init%InData_HD%MCFD = Init%OutData_SeaSt%MCFD - - ! CALL MOVE_ALLOC( Init%OutData_SeaSt%WaveElev0, Init%InData_HD%WaveElev0 ) - ! CALL MOVE_ALLOC( Init%OutData_SeaSt%WaveElevC, Init%InData_HD%WaveElevC ) - - ! Init%InData_HD%WaveTime => Init%OutData_SeaSt%WaveTime - ! Init%InData_HD%WaveElevC0 => Init%OutData_SeaSt%WaveElevC0 - ! Init%InData_HD%WaveDirArr => Init%OutData_SeaSt%WaveDirArr - ! Init%InData_HD%WaveElev1 => Init%OutData_SeaSt%WaveElev1 - ! Init%InData_HD%WaveElev2 => Init%OutData_SeaSt%WaveElev2 - ! Init%InData_HD%WaveDynP => Init%OutData_SeaSt%WaveDynP - ! Init%InData_HD%WaveAcc => Init%OutData_SeaSt%WaveAcc - ! Init%InData_HD%WaveVel => Init%OutData_SeaSt%WaveVel - ! Init%InData_HD%PWaveDynP0 => Init%OutData_SeaSt%PWaveDynP0 - ! Init%InData_HD%PWaveAcc0 => Init%OutData_SeaSt%PWaveAcc0 - ! Init%InData_HD%PWaveVel0 => Init%OutData_SeaSt%PWaveVel0 - ! Init%InData_HD%WaveAccMCF => Init%OutData_SeaSt%WaveAccMCF - ! Init%InData_HD%PWaveAccMCF0 => Init%OutData_SeaSt%PWaveAccMCF0 - - ! call SeaSt_Interp_CopyParam(Init%OutData_SeaSt%SeaSt_Interp_p, Init%InData_HD%SeaSt_Interp_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - ! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) Init%InData_HD%WaveField => Init%OutData_SeaSt%WaveField diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 3684f7fcd7..64f94c59dc 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -151,9 +151,6 @@ typedef ^ ^ ReKi del typedef ^ ^ ReKi X_HalfWidth - - - "Half-width of the domain in the X direction" m typedef ^ ^ ReKi Y_HalfWidth - - - "Half-width of the domain in the Y direction" m typedef ^ ^ ReKi Z_Depth - - - "Depth of the domain the Z direction" m -#typedef ^ ^ ReKi gridDX - - - "distance between kinematics grid points along the xi direction" m -#typedef ^ ^ ReKi gridDY - - - "distance between kinematics grid points along the yi direction" m -#typedef ^ ^ ReKi gridDTheta - - - "delta angle used for cosine-spaced zi direction kinematic grid points" rad typedef ^ ^ INTEGER NStepWave - - - "Number of user-requested data points in the wave kinematics arrays" - typedef ^ ^ INTEGER NWaveElev - - - "Number of wave elevation outputs" - typedef ^ ^ SiKi WaveElevxi {:} - - "xi-coordinates for points where the incident wave elevations can be output" (meters)